- 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 Feb 19, 2025@00:04:27 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")