SCAPMC6 ;ALB/REW - Team APIs:APPTTM ; 5 Jul 1995
;;5.3;Scheduling;**41**;AUG 13, 1993
;;1.0
ACPTTM(DFN,SCTM,SCFIELDA,SCACT,SCERR) ;add a patient to a team (pt tm assgn - #404.42
; input:
; DFN = pointer to PATIENT file (#2)
; SCTM = pointer to TEAM file (#404.51)
; SCFIELDA= array of additional fields to be added
; SCACT = date to activate [default=DT]
; SCERR = array NAME to store error messages.
; [ex. ^TMP("ORXX",$J)]
;
; Output:
; Returned = ien of 404.42 - 0 if none after^new?^Message
; SCERR() = Array of DIALOG file messages(errors) .
; Foramt:
; Subscript: Sequential # from 1 to n
; Piece Description
; 1 IEN of DIALOG file
N SCPTTM,SCESEQ,SCPARM,SCIEN,SC,SCFLD,SCNEWTM
G:'$$OKDATA APTTMQ ;check/setup variables
IF $S('$D(SCFIELDA):0,('($D(@SCFIELDA@(.08))#2)):0,($G(@SCFIELDA@(.08))=1):1,1:0) IF '$$OKPTTMPC^SCMCTMU2(DFN,SCTM,SCACT) D G APTTMQ
.S SCMESS=4044200.001
S SCPTTM=$$PTTMACT(DFN,SCTM,SCACT,.SCERR)
IF SCPTTM G APTTMQ
ELSE D
.IF $D(SCFIELDA) D
..S SCFLD=0
..F S SCFLD=$O(@SCFIELDA@(SCFLD)) Q:'SCFLD D
...S SC($J,404.42,"+1,",SCFLD)=@SCFIELDA@(SCFLD)
.S SC($J,404.42,"+1,",.01)=DFN
.S SC($J,404.42,"+1,",.02)=SCACT
.S SC($J,404.42,"+1,",.03)=SCTM
.D UPDATE^DIE("","SC($J)","SCIEN","SCERR")
.IF $D(@SCERR) K SCIEN
.ELSE D
..S SCPTTM=$G(SCIEN(1))
..S SCNEWTM=1
..D AFTERTM^SCMCDD1(SCPTTM)
APTTMQ Q +$G(SCPTTM)_U_+$G(SCNEWTM)
;
PTTMACT(DFN,SCTM,SCDT,SCERR) ;what is patient/team assignment on a given date-time into the future? Return 404.42 ien or 0
N SCTMLST,SCOK,SCPTTMDT
S SCOK=0
S SCPTTMDT("BEGIN")=SCDT,SCPTTMDT("END")=3990101,SCPTTMDT("INCL")=0
IF $$TMPT^SCAPMC3(DFN,"SCPTTMDT","","SCTMLST",.SCERR) S:$D(SCTMLST("SCTM",SCTM)) SCOK=$O(SCTMLST("SCTM",SCTM,0))
Q SCOK
;
ACPTATM(DFNA,SCTM,SCFIELDA,SCACT,SCERR,SCNEWTM,SCOLDTM,SCBADTM) ;list of patients assigned to a team (404.42)
; input: as per ACPTTM (above with the following change:)
; DFNA = is the literal value of a patient array (e.g. "scpt"
; there is at least one scpt(dfn)="" defined
; SCNEWTM = Subset of DFNA that was NEWLY assigned to Team [returned]
; SCOLDTM = Subset of DFNA that was already assigned -Team [returned]
; SCBADTP = Subset of DFNA that was NOT assigned to Team [returned]
; Note: The above three arrays return data in a user determined array
; output: Count of Patients:
; 1 2 3 4
; total assigned^newly assigned^assigned prior^not assigned
N DFN,SCNEWCNT,SCOLDCNT,SCBADCNT,SCX,SCNOMAIL
S SCNOMAIL=1
S (SCNEWCNT,SCOLDCNT,SCBADCNT)=0
S DFN=0 F S DFN=$O(@DFNA@(DFN)) Q:'DFN D
.S SCX=$$ACPTTM(.DFN,.SCTM,.SCFIELDA,.SCACT,.SCERR)
.; SCX = ien of 404.42^new?
.IF $P(SCX,U,2) D ;newly assigned
..S SCNEWCNT=SCNEWCNT+1
..S @SCNEWTM@(DFN)=+SCX ;scnewtm
.IF $P(SCX,U,1)&('$P(SCX,U,2)) D ;old
..S SCOLDCNT=SCOLDCNT+1
..S @SCOLDTM@(DFN)=+SCX
.IF 'SCX D
..S @SCBADTM@(DFN)=$P(SCX,U,3)
..S SCBADCNT=SCBADCNT+1
K SCNOMAIL
D MAILLST^SCMCTMM(SCTM,.SCADDFLD,DT,.SCNEWTM,.SCOLDTM,.SCBADTM)
Q (SCNEWCNT+SCOLDCNT)_U_SCNEWCNT_U_SCOLDCNT_U_SCBADCNT
;
OKDATA() ;setup/check variables
N SCOK
S SCOK=1
D INIT^SCAPMCU1(.SCOK)
IF '$D(^DPT(DFN,0))!('$D(^SCTM(404.51,SCTM,0))) D S SCOK=0
. S SCPARM("PATIENT")=DFN
. S SCPARM("TEAM")=SCTM
. D ERR^SCAPMCU1(SCESEQ,4045101,.SCPARM,"",.SCERR)
S:'$G(SCACT) SCACT=DT
Q SCOK
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCAPMC6 3551 printed Dec 13, 2024@02:38:09 Page 2
SCAPMC6 ;ALB/REW - Team APIs:APPTTM ; 5 Jul 1995
+1 ;;5.3;Scheduling;**41**;AUG 13, 1993
+2 ;;1.0
ACPTTM(DFN,SCTM,SCFIELDA,SCACT,SCERR) ;add a patient to a team (pt tm assgn - #404.42
+1 ; input:
+2 ; DFN = pointer to PATIENT file (#2)
+3 ; SCTM = pointer to TEAM file (#404.51)
+4 ; SCFIELDA= array of additional fields to be added
+5 ; SCACT = date to activate [default=DT]
+6 ; SCERR = array NAME to store error messages.
+7 ; [ex. ^TMP("ORXX",$J)]
+8 ;
+9 ; Output:
+10 ; Returned = ien of 404.42 - 0 if none after^new?^Message
+11 ; SCERR() = Array of DIALOG file messages(errors) .
+12 ; Foramt:
+13 ; Subscript: Sequential # from 1 to n
+14 ; Piece Description
+15 ; 1 IEN of DIALOG file
+16 NEW SCPTTM,SCESEQ,SCPARM,SCIEN,SC,SCFLD,SCNEWTM
+17 ;check/setup variables
if '$$OKDATA
GOTO APTTMQ
+18 IF $SELECT('$DATA(SCFIELDA):0,('($DATA(@SCFIELDA@(.08))#2)):0,($GET(@SCFIELDA@(.08))=1):1,1:0)
IF '$$OKPTTMPC^SCMCTMU2(DFN,SCTM,SCACT)
Begin DoDot:1
+19 SET SCMESS=4044200.001
End DoDot:1
GOTO APTTMQ
+20 SET SCPTTM=$$PTTMACT(DFN,SCTM,SCACT,.SCERR)
+21 IF SCPTTM
GOTO APTTMQ
+22 IF '$TEST
Begin DoDot:1
+23 IF $DATA(SCFIELDA)
Begin DoDot:2
+24 SET SCFLD=0
+25 FOR
SET SCFLD=$ORDER(@SCFIELDA@(SCFLD))
if 'SCFLD
QUIT
Begin DoDot:3
+26 SET SC($JOB,404.42,"+1,",SCFLD)=@SCFIELDA@(SCFLD)
End DoDot:3
End DoDot:2
+27 SET SC($JOB,404.42,"+1,",.01)=DFN
+28 SET SC($JOB,404.42,"+1,",.02)=SCACT
+29 SET SC($JOB,404.42,"+1,",.03)=SCTM
+30 DO UPDATE^DIE("","SC($J)","SCIEN","SCERR")
+31 IF $DATA(@SCERR)
KILL SCIEN
+32 IF '$TEST
Begin DoDot:2
+33 SET SCPTTM=$GET(SCIEN(1))
+34 SET SCNEWTM=1
+35 DO AFTERTM^SCMCDD1(SCPTTM)
End DoDot:2
End DoDot:1
APTTMQ QUIT +$GET(SCPTTM)_U_+$GET(SCNEWTM)
+1 ;
PTTMACT(DFN,SCTM,SCDT,SCERR) ;what is patient/team assignment on a given date-time into the future? Return 404.42 ien or 0
+1 NEW SCTMLST,SCOK,SCPTTMDT
+2 SET SCOK=0
+3 SET SCPTTMDT("BEGIN")=SCDT
SET SCPTTMDT("END")=3990101
SET SCPTTMDT("INCL")=0
+4 IF $$TMPT^SCAPMC3(DFN,"SCPTTMDT","","SCTMLST",.SCERR)
if $DATA(SCTMLST("SCTM",SCTM))
SET SCOK=$ORDER(SCTMLST("SCTM",SCTM,0))
+5 QUIT SCOK
+6 ;
ACPTATM(DFNA,SCTM,SCFIELDA,SCACT,SCERR,SCNEWTM,SCOLDTM,SCBADTM) ;list of patients assigned to a team (404.42)
+1 ; input: as per ACPTTM (above with the following change:)
+2 ; DFNA = is the literal value of a patient array (e.g. "scpt"
+3 ; there is at least one scpt(dfn)="" defined
+4 ; SCNEWTM = Subset of DFNA that was NEWLY assigned to Team [returned]
+5 ; SCOLDTM = Subset of DFNA that was already assigned -Team [returned]
+6 ; SCBADTP = Subset of DFNA that was NOT assigned to Team [returned]
+7 ; Note: The above three arrays return data in a user determined array
+8 ; output: Count of Patients:
+9 ; 1 2 3 4
+10 ; total assigned^newly assigned^assigned prior^not assigned
+11 NEW DFN,SCNEWCNT,SCOLDCNT,SCBADCNT,SCX,SCNOMAIL
+12 SET SCNOMAIL=1
+13 SET (SCNEWCNT,SCOLDCNT,SCBADCNT)=0
+14 SET DFN=0
FOR
SET DFN=$ORDER(@DFNA@(DFN))
if 'DFN
QUIT
Begin DoDot:1
+15 SET SCX=$$ACPTTM(.DFN,.SCTM,.SCFIELDA,.SCACT,.SCERR)
+16 ; SCX = ien of 404.42^new?
+17 ;newly assigned
IF $PIECE(SCX,U,2)
Begin DoDot:2
+18 SET SCNEWCNT=SCNEWCNT+1
+19 ;scnewtm
SET @SCNEWTM@(DFN)=+SCX
End DoDot:2
+20 ;old
IF $PIECE(SCX,U,1)&('$PIECE(SCX,U,2))
Begin DoDot:2
+21 SET SCOLDCNT=SCOLDCNT+1
+22 SET @SCOLDTM@(DFN)=+SCX
End DoDot:2
+23 IF 'SCX
Begin DoDot:2
+24 SET @SCBADTM@(DFN)=$PIECE(SCX,U,3)
+25 SET SCBADCNT=SCBADCNT+1
End DoDot:2
End DoDot:1
+26 KILL SCNOMAIL
+27 DO MAILLST^SCMCTMM(SCTM,.SCADDFLD,DT,.SCNEWTM,.SCOLDTM,.SCBADTM)
+28 QUIT (SCNEWCNT+SCOLDCNT)_U_SCNEWCNT_U_SCOLDCNT_U_SCBADCNT
+29 ;
OKDATA() ;setup/check variables
+1 NEW SCOK
+2 SET SCOK=1
+3 DO INIT^SCAPMCU1(.SCOK)
+4 IF '$DATA(^DPT(DFN,0))!('$DATA(^SCTM(404.51,SCTM,0)))
Begin DoDot:1
+5 SET SCPARM("PATIENT")=DFN
+6 SET SCPARM("TEAM")=SCTM
+7 DO ERR^SCAPMCU1(SCESEQ,4045101,.SCPARM,"",.SCERR)
End DoDot:1
SET SCOK=0
+8 if '$GET(SCACT)
SET SCACT=DT
+9 QUIT SCOK
