- SCAPMC20 ;ALB/REW - Team APIs:APPTTM ; 20 Mar 1996
- ;;5.3;Scheduling;**41,1015**;AUG 13, 1993;Build 21
- ;;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
- SCAPMC20 ;ALB/REW - Team APIs:APPTTM ; 20 Mar 1996
- +1 ;;5.3;Scheduling;**41,1015**;AUG 13, 1993;Build 21
- +2 ;;1.0
- ACOUTPT(DFN,SCFIELDA,SCERR) ;add/edit a record in OUTPATIENT PROFILE #404.41
- +1 ; input:
- +2 ; DFN = pointer to PATIENT file (#2)
- +3 ; SCFIELDA= array of additional fields to be added
- +4 ; SCERR = array NAME to store error messages.
- +5 ; [ex. ^TMP("ORXX",$J)]
- +6 ;
- +7 ; Output:
- +8 ; Returned = ok?^404.41 ien^new?
- +9 ; SCERR() = Array of DIALOG file messages(errors) .
- +10 ; Foramt:
- +11 ; Subscript: Sequential # from 1 to n
- +12 ; Piece Description
- +13 ; 1 IEN of DIALOG file
- +14 NEW SCEXIST
- +15 NEW SCESEQ,SCPARM,SCIEN,SC,SCFLD
- +16 ;check/setup variables
- IF '$$OKDATA
- GOTO APTTMQ
- +17 SET SCEXIST=$DATA(^SCPT(404.41,DFN,0))#2
- +18 IF SCEXIST
- Begin DoDot:1
- +19 IF $DATA(SCFIELDA)
- Begin DoDot:2
- +20 SET SCFLD=0
- +21 FOR
- SET SCFLD=$ORDER(@SCFIELDA@(SCFLD))
- IF 'SCFLD
- QUIT
- Begin DoDot:3
- +22 SET SC($JOB,404.41,(+DFN)_",",SCFLD)=@SCFIELDA@(SCFLD)
- End DoDot:3
- End DoDot:2
- +23 DO FILE^DIE("E","SC($J)",SCERR)
- End DoDot:1
- +24 IF '$TEST
- Begin DoDot:1
- +25 SET SCIEN(1)=DFN
- +26 SET SC($JOB,404.41,"+1,",.01)="`"_DFN
- +27 IF $DATA(SCFIELDA)
- Begin DoDot:2
- +28 SET SCFLD=0
- +29 FOR
- SET SCFLD=$ORDER(@SCFIELDA@(SCFLD))
- IF 'SCFLD
- QUIT
- Begin DoDot:3
- +30 SET SC($JOB,404.41,"+1,",SCFLD)=@SCFIELDA@(SCFLD)
- End DoDot:3
- End DoDot:2
- +31 DO UPDATE^DIE("E","SC($J)","SCIEN",SCERR)
- +32 IF $DATA(@SCERR)!($GET(SCIEN(1))'=DFN)
- SET @SCERR=1
- KILL SCIEN
- +33 IF '$TEST
- Begin DoDot:2
- +34 SET SCEXIST=0
- End DoDot:2
- End DoDot:1
- APTTMQ QUIT '$DATA(@SCERR@(0))_U_+$GET(DFN)_U_'$GET(SCEXIST)
- +1 ;
- OKDATA() ;setup/check variables
- +1 NEW SCOK
- +2 SET SCOK=1
- +3 DO INIT^SCAPMCU1(.SCOK)
- +4 IF '$DATA(^DPT(DFN,0))
- Begin DoDot:1
- +5 SET SCPARM("PATIENT")=DFN
- +6 DO ERR^SCAPMCU1(SCESEQ,4045101,.SCPARM,"",.SCERR)
- End DoDot:1
- SET SCOK=0
- +7 QUIT SCOK
- +8 ;
- MAKEMANY(DFNA,SCOLDASS,SCBADASS,SCNEWASS) ;Not supported for use by PCMM Only
- +1 ; DFNA - DFN ARRAY
- +2 ; SCOLDASS - Subset of DFNA that were previously assigned
- +3 ; SCBADASS - Subset of DFNA that could not be assigned
- +4 ; SCNEWASS - Subset of DFNA that were newly assigned
- +5 ; Return: total^new^old^bad
- +6 ; Note: No input error checking!!
- +7 NEW DFN,SCX,SCOUTFLD,SCBADOUT,SCBADCNT,SCNEWCND,SCOLDCNT
- +8 SET (SCBADCNT,SCNEWCNT,SCOLDCNT)=0
- +9 SET DFN=0
- +10 FOR
- SET DFN=$ORDER(@DFNA@(DFN))
- IF 'DFN
- QUIT
- Begin DoDot:1
- +11 SET SCOUTFLD(.04)=1
- +12 SET SCX=$$ACOUTPT(DFN,"SCOUTFLD","SCBADOUT")
- +13 IF 'SCX
- Begin DoDot:2
- +14 SET @SCBADASS@(DFN)=""
- +15 SET SCBADCNT=SCBADCNT+1
- End DoDot:2
- +16 IF '$TEST
- Begin DoDot:2
- +17 IF $PIECE(SCX,U,3)
- Begin DoDot:3
- +18 SET @SCNEWASS@(DFN)=""
- +19 SET SCNEWCNT=SCNEWCNT+1
- End DoDot:3
- +20 IF '$TEST
- Begin DoDot:3
- +21 SET @SCOLDASS@(DFN)=""
- +22 SET SCOLDCNT=SCOLDCNT+1
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +23 QUIT (SCOLDCNT+SCNEWCNT)_U_SCNEWCNT_U_SCOLDCNT_U_SCBADCNT
- +24 ;
- PTPCNOTM(SCOUTA,SCDATE) ;Not Supported For Use by PCMM Only
- +1 ; SCOUTA - Output array of DFNs that are PC but no Team Now
- +2 NEW DFN,SCPC
- +3 SET DFN=0
- +4 FOR
- SET DFN=$ORDER(^SCPT(404.41,"APC",DFN))
- IF 'DFN
- QUIT
- SET SCPC=$ORDER(^(DFN))
- IF 'SCPC
- QUIT
- Begin DoDot:1
- +5 IF $DATA(^TMP("SCMC",$JOB,"EXCLUDE PT","SCPTA",+DFN))
- QUIT
- +6 IF '$$GETPCTM^SCAPMCU2(DFN,SCDATE,1)
- SET @SCOUTA@(DFN)=DFN_U_$PIECE($GET(^DPT(DFN,0)),U,1)
- End DoDot:1
- +7 QUIT
