| [613] | 1 | SCAPMC20 ;ALB/REW - Team APIs:APPTTM ; 20 Mar 1996
|
|---|
| 2 | ;;5.3;Scheduling;**41**;AUG 13, 1993
|
|---|
| 3 | ;;1.0
|
|---|
| 4 | ACOUTPT(DFN,SCFIELDA,SCERR) ;add/edit a record in OUTPATIENT PROFILE #404.41
|
|---|
| 5 | ; input:
|
|---|
| 6 | ; DFN = pointer to PATIENT file (#2)
|
|---|
| 7 | ; SCFIELDA= array of additional fields to be added
|
|---|
| 8 | ; SCERR = array NAME to store error messages.
|
|---|
| 9 | ; [ex. ^TMP("ORXX",$J)]
|
|---|
| 10 | ;
|
|---|
| 11 | ; Output:
|
|---|
| 12 | ; Returned = ok?^404.41 ien^new?
|
|---|
| 13 | ; SCERR() = Array of DIALOG file messages(errors) .
|
|---|
| 14 | ; Foramt:
|
|---|
| 15 | ; Subscript: Sequential # from 1 to n
|
|---|
| 16 | ; Piece Description
|
|---|
| 17 | ; 1 IEN of DIALOG file
|
|---|
| 18 | N SCEXIST
|
|---|
| 19 | N SCESEQ,SCPARM,SCIEN,SC,SCFLD
|
|---|
| 20 | G:'$$OKDATA APTTMQ ;check/setup variables
|
|---|
| 21 | S SCEXIST=$D(^SCPT(404.41,DFN,0))#2
|
|---|
| 22 | IF SCEXIST D
|
|---|
| 23 | .IF $D(SCFIELDA) D
|
|---|
| 24 | ..S SCFLD=0
|
|---|
| 25 | ..F S SCFLD=$O(@SCFIELDA@(SCFLD)) Q:'SCFLD D
|
|---|
| 26 | ...S SC($J,404.41,(+DFN)_",",SCFLD)=@SCFIELDA@(SCFLD)
|
|---|
| 27 | .D FILE^DIE("E","SC($J)",SCERR)
|
|---|
| 28 | ELSE D
|
|---|
| 29 | .S SCIEN(1)=DFN
|
|---|
| 30 | .S SC($J,404.41,"+1,",.01)="`"_DFN
|
|---|
| 31 | .IF $D(SCFIELDA) D
|
|---|
| 32 | ..S SCFLD=0
|
|---|
| 33 | ..F S SCFLD=$O(@SCFIELDA@(SCFLD)) Q:'SCFLD D
|
|---|
| 34 | ...S SC($J,404.41,"+1,",SCFLD)=@SCFIELDA@(SCFLD)
|
|---|
| 35 | .D UPDATE^DIE("E","SC($J)","SCIEN",SCERR)
|
|---|
| 36 | .IF $D(@SCERR)!($G(SCIEN(1))'=DFN) S @SCERR=1 K SCIEN
|
|---|
| 37 | .ELSE D
|
|---|
| 38 | ..S SCEXIST=0
|
|---|
| 39 | APTTMQ Q '$D(@SCERR@(0))_U_+$G(DFN)_U_'$G(SCEXIST)
|
|---|
| 40 | ;
|
|---|
| 41 | OKDATA() ;setup/check variables
|
|---|
| 42 | N SCOK
|
|---|
| 43 | S SCOK=1
|
|---|
| 44 | D INIT^SCAPMCU1(.SCOK)
|
|---|
| 45 | IF '$D(^DPT(DFN,0)) D S SCOK=0
|
|---|
| 46 | . S SCPARM("PATIENT")=DFN
|
|---|
| 47 | . D ERR^SCAPMCU1(SCESEQ,4045101,.SCPARM,"",.SCERR)
|
|---|
| 48 | Q SCOK
|
|---|
| 49 | ;
|
|---|
| 50 | MAKEMANY(DFNA,SCOLDASS,SCBADASS,SCNEWASS) ;Not supported for use by PCMM Only
|
|---|
| 51 | ; DFNA - DFN ARRAY
|
|---|
| 52 | ; SCOLDASS - Subset of DFNA that were previously assigned
|
|---|
| 53 | ; SCBADASS - Subset of DFNA that could not be assigned
|
|---|
| 54 | ; SCNEWASS - Subset of DFNA that were newly assigned
|
|---|
| 55 | ; Return: total^new^old^bad
|
|---|
| 56 | ; Note: No input error checking!!
|
|---|
| 57 | N DFN,SCX,SCOUTFLD,SCBADOUT,SCBADCNT,SCNEWCND,SCOLDCNT
|
|---|
| 58 | S (SCBADCNT,SCNEWCNT,SCOLDCNT)=0
|
|---|
| 59 | S DFN=0
|
|---|
| 60 | F S DFN=$O(@DFNA@(DFN)) Q:'DFN D
|
|---|
| 61 | .S SCOUTFLD(.04)=1
|
|---|
| 62 | .S SCX=$$ACOUTPT(DFN,"SCOUTFLD","SCBADOUT")
|
|---|
| 63 | .IF 'SCX D
|
|---|
| 64 | ..S @SCBADASS@(DFN)=""
|
|---|
| 65 | ..S SCBADCNT=SCBADCNT+1
|
|---|
| 66 | .ELSE D
|
|---|
| 67 | ..IF $P(SCX,U,3) D
|
|---|
| 68 | ...S @SCNEWASS@(DFN)=""
|
|---|
| 69 | ...S SCNEWCNT=SCNEWCNT+1
|
|---|
| 70 | ..ELSE D
|
|---|
| 71 | ...S @SCOLDASS@(DFN)=""
|
|---|
| 72 | ...S SCOLDCNT=SCOLDCNT+1
|
|---|
| 73 | Q (SCOLDCNT+SCNEWCNT)_U_SCNEWCNT_U_SCOLDCNT_U_SCBADCNT
|
|---|
| 74 | ;
|
|---|
| 75 | PTPCNOTM(SCOUTA,SCDATE) ;Not Supported For Use by PCMM Only
|
|---|
| 76 | ; SCOUTA - Output array of DFNs that are PC but no Team Now
|
|---|
| 77 | N DFN,SCPC
|
|---|
| 78 | S DFN=0
|
|---|
| 79 | F S DFN=$O(^SCPT(404.41,"APC",DFN)) Q:'DFN S SCPC=$O(^(DFN)) Q:'SCPC D
|
|---|
| 80 | .Q:$D(^TMP("SCMC",$J,"EXCLUDE PT","SCPTA",+DFN))
|
|---|
| 81 | .S:'$$GETPCTM^SCAPMCU2(DFN,SCDATE,1) @SCOUTA@(DFN)=DFN_U_$P($G(^DPT(DFN,0)),U,1)
|
|---|
| 82 | Q
|
|---|
