83 lines
2.6 KiB
Mathematica
83 lines
2.6 KiB
Mathematica
SCAPMC20 ;ALB/REW - Team APIs:APPTTM ; 20 Mar 1996
|
|
;;5.3;Scheduling;**41**;AUG 13, 1993
|
|
;;1.0
|
|
ACOUTPT(DFN,SCFIELDA,SCERR) ;add/edit a record in OUTPATIENT PROFILE #404.41
|
|
; input:
|
|
; DFN = pointer to PATIENT file (#2)
|
|
; SCFIELDA= array of additional fields to be added
|
|
; SCERR = array NAME to store error messages.
|
|
; [ex. ^TMP("ORXX",$J)]
|
|
;
|
|
; Output:
|
|
; Returned = ok?^404.41 ien^new?
|
|
; SCERR() = Array of DIALOG file messages(errors) .
|
|
; Foramt:
|
|
; Subscript: Sequential # from 1 to n
|
|
; Piece Description
|
|
; 1 IEN of DIALOG file
|
|
N SCEXIST
|
|
N SCESEQ,SCPARM,SCIEN,SC,SCFLD
|
|
G:'$$OKDATA APTTMQ ;check/setup variables
|
|
S SCEXIST=$D(^SCPT(404.41,DFN,0))#2
|
|
IF SCEXIST D
|
|
.IF $D(SCFIELDA) D
|
|
..S SCFLD=0
|
|
..F S SCFLD=$O(@SCFIELDA@(SCFLD)) Q:'SCFLD D
|
|
...S SC($J,404.41,(+DFN)_",",SCFLD)=@SCFIELDA@(SCFLD)
|
|
.D FILE^DIE("E","SC($J)",SCERR)
|
|
ELSE D
|
|
.S SCIEN(1)=DFN
|
|
.S SC($J,404.41,"+1,",.01)="`"_DFN
|
|
.IF $D(SCFIELDA) D
|
|
..S SCFLD=0
|
|
..F S SCFLD=$O(@SCFIELDA@(SCFLD)) Q:'SCFLD D
|
|
...S SC($J,404.41,"+1,",SCFLD)=@SCFIELDA@(SCFLD)
|
|
.D UPDATE^DIE("E","SC($J)","SCIEN",SCERR)
|
|
.IF $D(@SCERR)!($G(SCIEN(1))'=DFN) S @SCERR=1 K SCIEN
|
|
.ELSE D
|
|
..S SCEXIST=0
|
|
APTTMQ Q '$D(@SCERR@(0))_U_+$G(DFN)_U_'$G(SCEXIST)
|
|
;
|
|
OKDATA() ;setup/check variables
|
|
N SCOK
|
|
S SCOK=1
|
|
D INIT^SCAPMCU1(.SCOK)
|
|
IF '$D(^DPT(DFN,0)) D S SCOK=0
|
|
. S SCPARM("PATIENT")=DFN
|
|
. D ERR^SCAPMCU1(SCESEQ,4045101,.SCPARM,"",.SCERR)
|
|
Q SCOK
|
|
;
|
|
MAKEMANY(DFNA,SCOLDASS,SCBADASS,SCNEWASS) ;Not supported for use by PCMM Only
|
|
; DFNA - DFN ARRAY
|
|
; SCOLDASS - Subset of DFNA that were previously assigned
|
|
; SCBADASS - Subset of DFNA that could not be assigned
|
|
; SCNEWASS - Subset of DFNA that were newly assigned
|
|
; Return: total^new^old^bad
|
|
; Note: No input error checking!!
|
|
N DFN,SCX,SCOUTFLD,SCBADOUT,SCBADCNT,SCNEWCND,SCOLDCNT
|
|
S (SCBADCNT,SCNEWCNT,SCOLDCNT)=0
|
|
S DFN=0
|
|
F S DFN=$O(@DFNA@(DFN)) Q:'DFN D
|
|
.S SCOUTFLD(.04)=1
|
|
.S SCX=$$ACOUTPT(DFN,"SCOUTFLD","SCBADOUT")
|
|
.IF 'SCX D
|
|
..S @SCBADASS@(DFN)=""
|
|
..S SCBADCNT=SCBADCNT+1
|
|
.ELSE D
|
|
..IF $P(SCX,U,3) D
|
|
...S @SCNEWASS@(DFN)=""
|
|
...S SCNEWCNT=SCNEWCNT+1
|
|
..ELSE D
|
|
...S @SCOLDASS@(DFN)=""
|
|
...S SCOLDCNT=SCOLDCNT+1
|
|
Q (SCOLDCNT+SCNEWCNT)_U_SCNEWCNT_U_SCOLDCNT_U_SCBADCNT
|
|
;
|
|
PTPCNOTM(SCOUTA,SCDATE) ;Not Supported For Use by PCMM Only
|
|
; SCOUTA - Output array of DFNs that are PC but no Team Now
|
|
N DFN,SCPC
|
|
S DFN=0
|
|
F S DFN=$O(^SCPT(404.41,"APC",DFN)) Q:'DFN S SCPC=$O(^(DFN)) Q:'SCPC D
|
|
.Q:$D(^TMP("SCMC",$J,"EXCLUDE PT","SCPTA",+DFN))
|
|
.S:'$$GETPCTM^SCAPMCU2(DFN,SCDATE,1) @SCOUTA@(DFN)=DFN_U_$P($G(^DPT(DFN,0)),U,1)
|
|
Q
|