SCAPMC25 ;ALB/REW - Team API's:MSGDTH ; may 1999
;;5.3;Scheduling;**41,177,297**;AUG 13, 1993
;;1.0
MSGPT(MSGTYPE,DFN,SCTEAMA,SCDATES,SCYESCL,SCLIST,SCERR) ; users getting death message
; Input:
; MSGTYPE:
; 1 = Death Message
; 2 = Inpatient Message
; 3 = Team Message
; 4 = Consult Message
; 5 = Inactivation Message
;
; DFN - Pointer to Patient File #2
; SCTEAMA -array of pointers to team file 404.51
; if none are defined - returns all teams
; if @scteama@('exclude') is defined - exclude listed teams
; SCDATES("BEGIN") = begin date to search (inclusive)
; [default: TODAY]
; ("END") = end date to search (inclusive)
; [default: TODAY]
; ("INCL") = 1: only use pracitioners who were on
; team for entire date range
; 0: anytime in date range
; [default: 1]
; SCYESCL -boolean[1-yes(default)/0-no] Include pts asc. via enrollment?
; SCLIST - Name of output array
; SCERR = array NAME to store error messages.
; [ex. ^TMP("ORXX",$J
; Output:
; SCLIST() = array of practitioners (users) - pointers to file #200
; Format:
; Subscript: Sequential # from 1 to n
; Piece Description
; 1 IEN of NEW PERSON file entry (#200)
; 2 .01 of file #200
; SCERR() = Array of DIALOG file messages(errors) .
; @SCERR(0)= Number of error(s), UNDEFINED if no errors
; Foramt:
; Subscript: Sequential # from 1 to n
; Piece Description
; 1 IEN of DIALOG file
; Returned: 1 if ok, 0 if error
;
ST N SCOK,SCTM,SCTP,SCX,SCY,NODE,SCZ,SCTPND
N SCLSEQ,SCN,SCESEQ,SCPARM,SCP,SCBEGIN,SCEND,SCINCL,SCDTS
S SCOK=1
; -- initialize control variables
G:'$$OKDATA MSGQ
;given patient get list of their teams
S SCOK=$$TMPT^SCAPMC(DFN,SCDATES,,"^TMP(""SCMSG1"",$J)",.SCERR)
G:SCOK<1 MSGQ
;validate teams
F SCX=1:1 S NODE=$G(^TMP("SCMSG1",$J,SCX)) Q:'NODE S SCTM=+NODE D:$$OKARRAY^SCAPU1(.SCTEAMA,SCTM) Q:SCOK<1
.;given teams get list of their positions
.S SCZ=$$TPTM^SCAPMC(SCTM,SCDATES,,,"^TMP(""SCMSG2"",$J)",.SCERR)
.Q:'SCZ
.IF SCZ<0 S SCOK=-1 Q
.;given list of valid positions get list of practitioners
; should position get message?
;;bp/cmf **177** begin
F SCY=1:1 S SCTPND=$G(^TMP("SCMSG2",$J,SCY)) Q:'SCTPND D
.S SCTP=$P(SCTPND,U,1)
.D:$$OKPOS(MSGTYPE,SCTP,DFN,SCYESCL,SCDATES,.SCERR)
..;given list of valid positions get current practitioners
..S SCOK=$$PRTP^SCAPMC(SCTP,SCDATES,.SCLIST,.SCERR)
..Q
.;new code here
.;if preceptor notice turned on for message type
.I +$P($G(^SCTM(404.57,SCTP,2)),U,MSGTYPE+4) D
..S SCX=+$$OKPREC2^SCMCLK(SCTP,DT)
..;if preceptor duz returned, add to array
..I SCX S @SCLIST@("SCPR",SCX)=""
..Q
.Q
;
;;bp/cmf **177** orig begin
;;o;;F SCY=1:1 S SCTPND=$G(^TMP("SCMSG2",$J,SCY)) Q:'SCTPND S SCTP=$P(SCTPND,U,1) D:$$OKPOS(MSGTYPE,SCTP,DFN,SCYESCL,SCDATES,.SCERR)
;;o;;.;given list of valid positions get current practitioners
;;o;;.S SCOK=$$PRTP^SCAPMC(SCTP,SCDATES,.SCLIST,.SCERR)
;;bp/cmf **177** orig end
;;bp/cmf **177** end
MSGQ F SCZ="SCMSG1","SCMSG2","SCMSG3" K ^TMP(SCZ)
PRACQ Q $G(@SCERR@(0))<1
;
OKPOS(MSGTYPE,SCTP,DFN,SCYESCL,SCDATES,SCERR) ;check if message should go out to position for given pt
;needs pre-validated input
;return 1=ok,0=not ok
N GETMESS,SCOK,SCX,SCTM
K ^TMP("SCMSG3",$J)
S SCTM=$P($G(^SCTM(404.57,SCTP,0)),U,2)
S GETMESS=$P($G(^SCTM(404.57,SCTP,2)),U,MSGTYPE)
S:"T"[GETMESS SCOK=1 ;if null give messages
S:GETMESS="N" SCOK=0
IF GETMESS="P" D
.;check if pt is assigned to position
.S SCX=$$TPPT^SCAPMC(DFN,SCDATES,,,,,SCYESCL,"^TMP(""SCMSG3"",$J)",.SCERR)
.S SCOK=$D(^TMP("SCMSG3",$J,"SCTP",SCTM,SCTP))
.S:SCX<0 SCOK="-1^Error in position-patient call"
K ^TMP("SCMSG3",$J)
Q SCOK
;
OKDATA() ;setup/check variables
N SCOK
S SCOK=1
D INIT^SCAPMCU1(.SCOK) ; set default dates & error array (if undefined)
S:'$L($G(SCYESCL)) SCYESCL=1
IF '$D(^DPT(+$G(DFN),0)) D S SCOK=0
. S SCPARM("PATIENT")=$G(PATIENT,"Undefined")
. D ERR^SCAPMCU1(.SCESEQ,4045101,.SCPARM,"",.SCERR)
;
; -- is it a valid DFN passed (Error # 20001 in DIALOG file)
IF '$D(^DPT(+DFN,0)) D S SCOK=0
. S SCPARM("PATIENT")=DFN
. D ERR^SCAPMCU1(SCESEQ,20001,.SCPARM,"",.SCERR)
Q SCOK
;
PCMMXMY(MSGTYPE,DFN,SCTEAMA,SCDATES,SCYESCL) ;create xmy array for the appropriate type of pcmm mess
; return 1 if success,0 if error or no users receiving message
N SCOK,SCGROUP,SC200,SCGROUP
IF '$G(MSGTYPE) S SCOK=0 G QTXMY
S SCOK=1
S SCOK=$$MSGPT(MSGTYPE,.DFN,.SCTEAMA,.SCDATES,.SCYESCL,"^TMP(""SC PCMM MAIL"",$J)")
S SC200=0
F S SC200=$O(^TMP("SC PCMM MAIL",$J,"SCPR",SC200)) Q:'SC200 S XMY(SC200)=""
IF $D(XMY) D
.S XMY(.5)=""
ELSE D
.S SCOK=0
.S XMY(.5)=""
K ^TMP("SC PCMM MAIL",$J)
QTXMY Q SCOK
;
MSGTEXT(MSGTYPE) ;
Q $S(MSGTYPE=1:"DEATH",(MSGTYPE=2):"INPATIENT",(MSGTYPE=3):"TEAM",(MSGTYPE=4):"CONSULT",(MSGTYPE=5):"INACTIVATION",1:"ERROR")
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCAPMC25 5243 printed Oct 16, 2024@18:38:36 Page 2
SCAPMC25 ;ALB/REW - Team API's:MSGDTH ; may 1999
+1 ;;5.3;Scheduling;**41,177,297**;AUG 13, 1993
+2 ;;1.0
MSGPT(MSGTYPE,DFN,SCTEAMA,SCDATES,SCYESCL,SCLIST,SCERR) ; users getting death message
+1 ; Input:
+2 ; MSGTYPE:
+3 ; 1 = Death Message
+4 ; 2 = Inpatient Message
+5 ; 3 = Team Message
+6 ; 4 = Consult Message
+7 ; 5 = Inactivation Message
+8 ;
+9 ; DFN - Pointer to Patient File #2
+10 ; SCTEAMA -array of pointers to team file 404.51
+11 ; if none are defined - returns all teams
+12 ; if @scteama@('exclude') is defined - exclude listed teams
+13 ; SCDATES("BEGIN") = begin date to search (inclusive)
+14 ; [default: TODAY]
+15 ; ("END") = end date to search (inclusive)
+16 ; [default: TODAY]
+17 ; ("INCL") = 1: only use pracitioners who were on
+18 ; team for entire date range
+19 ; 0: anytime in date range
+20 ; [default: 1]
+21 ; SCYESCL -boolean[1-yes(default)/0-no] Include pts asc. via enrollment?
+22 ; SCLIST - Name of output array
+23 ; SCERR = array NAME to store error messages.
+24 ; [ex. ^TMP("ORXX",$J
+25 ; Output:
+26 ; SCLIST() = array of practitioners (users) - pointers to file #200
+27 ; Format:
+28 ; Subscript: Sequential # from 1 to n
+29 ; Piece Description
+30 ; 1 IEN of NEW PERSON file entry (#200)
+31 ; 2 .01 of file #200
+32 ; SCERR() = Array of DIALOG file messages(errors) .
+33 ; @SCERR(0)= Number of error(s), UNDEFINED if no errors
+34 ; Foramt:
+35 ; Subscript: Sequential # from 1 to n
+36 ; Piece Description
+37 ; 1 IEN of DIALOG file
+38 ; Returned: 1 if ok, 0 if error
+39 ;
ST NEW SCOK,SCTM,SCTP,SCX,SCY,NODE,SCZ,SCTPND
+1 NEW SCLSEQ,SCN,SCESEQ,SCPARM,SCP,SCBEGIN,SCEND,SCINCL,SCDTS
+2 SET SCOK=1
+3 ; -- initialize control variables
+4 if '$$OKDATA
GOTO MSGQ
+5 ;given patient get list of their teams
+6 SET SCOK=$$TMPT^SCAPMC(DFN,SCDATES,,"^TMP(""SCMSG1"",$J)",.SCERR)
+7 if SCOK<1
GOTO MSGQ
+8 ;validate teams
+9 FOR SCX=1:1
SET NODE=$GET(^TMP("SCMSG1",$JOB,SCX))
if 'NODE
QUIT
SET SCTM=+NODE
if $$OKARRAY^SCAPU1(.SCTEAMA,SCTM)
Begin DoDot:1
+10 ;given teams get list of their positions
+11 SET SCZ=$$TPTM^SCAPMC(SCTM,SCDATES,,,"^TMP(""SCMSG2"",$J)",.SCERR)
+12 if 'SCZ
QUIT
+13 IF SCZ<0
SET SCOK=-1
QUIT
+14 ;given list of valid positions get list of practitioners
End DoDot:1
if SCOK<1
QUIT
+15 ; should position get message?
+16 ;;bp/cmf **177** begin
+17 FOR SCY=1:1
SET SCTPND=$GET(^TMP("SCMSG2",$JOB,SCY))
if 'SCTPND
QUIT
Begin DoDot:1
+18 SET SCTP=$PIECE(SCTPND,U,1)
+19 if $$OKPOS(MSGTYPE,SCTP,DFN,SCYESCL,SCDATES,.SCERR)
Begin DoDot:2
+20 ;given list of valid positions get current practitioners
+21 SET SCOK=$$PRTP^SCAPMC(SCTP,SCDATES,.SCLIST,.SCERR)
+22 QUIT
End DoDot:2
+23 ;new code here
+24 ;if preceptor notice turned on for message type
+25 IF +$PIECE($GET(^SCTM(404.57,SCTP,2)),U,MSGTYPE+4)
Begin DoDot:2
+26 SET SCX=+$$OKPREC2^SCMCLK(SCTP,DT)
+27 ;if preceptor duz returned, add to array
+28 IF SCX
SET @SCLIST@("SCPR",SCX)=""
+29 QUIT
End DoDot:2
+30 QUIT
End DoDot:1
+31 ;
+32 ;;bp/cmf **177** orig begin
+33 ;;o;;F SCY=1:1 S SCTPND=$G(^TMP("SCMSG2",$J,SCY)) Q:'SCTPND S SCTP=$P(SCTPND,U,1) D:$$OKPOS(MSGTYPE,SCTP,DFN,SCYESCL,SCDATES,.SCERR)
+34 ;;o;;.;given list of valid positions get current practitioners
+35 ;;o;;.S SCOK=$$PRTP^SCAPMC(SCTP,SCDATES,.SCLIST,.SCERR)
+36 ;;bp/cmf **177** orig end
+37 ;;bp/cmf **177** end
MSGQ FOR SCZ="SCMSG1","SCMSG2","SCMSG3"
KILL ^TMP(SCZ)
PRACQ QUIT $GET(@SCERR@(0))<1
+1 ;
OKPOS(MSGTYPE,SCTP,DFN,SCYESCL,SCDATES,SCERR) ;check if message should go out to position for given pt
+1 ;needs pre-validated input
+2 ;return 1=ok,0=not ok
+3 NEW GETMESS,SCOK,SCX,SCTM
+4 KILL ^TMP("SCMSG3",$JOB)
+5 SET SCTM=$PIECE($GET(^SCTM(404.57,SCTP,0)),U,2)
+6 SET GETMESS=$PIECE($GET(^SCTM(404.57,SCTP,2)),U,MSGTYPE)
+7 ;if null give messages
if "T"[GETMESS
SET SCOK=1
+8 if GETMESS="N"
SET SCOK=0
+9 IF GETMESS="P"
Begin DoDot:1
+10 ;check if pt is assigned to position
+11 SET SCX=$$TPPT^SCAPMC(DFN,SCDATES,,,,,SCYESCL,"^TMP(""SCMSG3"",$J)",.SCERR)
+12 SET SCOK=$DATA(^TMP("SCMSG3",$JOB,"SCTP",SCTM,SCTP))
+13 if SCX<0
SET SCOK="-1^Error in position-patient call"
End DoDot:1
+14 KILL ^TMP("SCMSG3",$JOB)
+15 QUIT SCOK
+16 ;
OKDATA() ;setup/check variables
+1 NEW SCOK
+2 SET SCOK=1
+3 ; set default dates & error array (if undefined)
DO INIT^SCAPMCU1(.SCOK)
+4 if '$LENGTH($GET(SCYESCL))
SET SCYESCL=1
+5 IF '$DATA(^DPT(+$GET(DFN),0))
Begin DoDot:1
+6 SET SCPARM("PATIENT")=$GET(PATIENT,"Undefined")
+7 DO ERR^SCAPMCU1(.SCESEQ,4045101,.SCPARM,"",.SCERR)
End DoDot:1
SET SCOK=0
+8 ;
+9 ; -- is it a valid DFN passed (Error # 20001 in DIALOG file)
+10 IF '$DATA(^DPT(+DFN,0))
Begin DoDot:1
+11 SET SCPARM("PATIENT")=DFN
+12 DO ERR^SCAPMCU1(SCESEQ,20001,.SCPARM,"",.SCERR)
End DoDot:1
SET SCOK=0
+13 QUIT SCOK
+14 ;
PCMMXMY(MSGTYPE,DFN,SCTEAMA,SCDATES,SCYESCL) ;create xmy array for the appropriate type of pcmm mess
+1 ; return 1 if success,0 if error or no users receiving message
+2 NEW SCOK,SCGROUP,SC200,SCGROUP
+3 IF '$GET(MSGTYPE)
SET SCOK=0
GOTO QTXMY
+4 SET SCOK=1
+5 SET SCOK=$$MSGPT(MSGTYPE,.DFN,.SCTEAMA,.SCDATES,.SCYESCL,"^TMP(""SC PCMM MAIL"",$J)")
+6 SET SC200=0
+7 FOR
SET SC200=$ORDER(^TMP("SC PCMM MAIL",$JOB,"SCPR",SC200))
if 'SC200
QUIT
SET XMY(SC200)=""
+8 IF $DATA(XMY)
Begin DoDot:1
+9 SET XMY(.5)=""
End DoDot:1
+10 IF '$TEST
Begin DoDot:1
+11 SET SCOK=0
+12 SET XMY(.5)=""
End DoDot:1
+13 KILL ^TMP("SC PCMM MAIL",$JOB)
QTXMY QUIT SCOK
+1 ;
MSGTEXT(MSGTYPE) ;
+1 QUIT $SELECT(MSGTYPE=1:"DEATH",(MSGTYPE=2):"INPATIENT",(MSGTYPE=3):"TEAM",(MSGTYPE=4):"CONSULT",(MSGTYPE=5):"INACTIVATION",1:"ERROR")
