Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SCAPMC25

SCAPMC25.m

Go to the documentation of this file.
  1. SCAPMC25 ;ALB/REW - Team API's:MSGDTH ; may 1999
  1. ;;5.3;Scheduling;**41,177,297**;AUG 13, 1993
  1. ;;1.0
  1. MSGPT(MSGTYPE,DFN,SCTEAMA,SCDATES,SCYESCL,SCLIST,SCERR) ; users getting death message
  1. ; Input:
  1. ; MSGTYPE:
  1. ; 1 = Death Message
  1. ; 2 = Inpatient Message
  1. ; 3 = Team Message
  1. ; 4 = Consult Message
  1. ; 5 = Inactivation Message
  1. ;
  1. ; DFN - Pointer to Patient File #2
  1. ; SCTEAMA -array of pointers to team file 404.51
  1. ; if none are defined - returns all teams
  1. ; if @scteama@('exclude') is defined - exclude listed teams
  1. ; SCDATES("BEGIN") = begin date to search (inclusive)
  1. ; [default: TODAY]
  1. ; ("END") = end date to search (inclusive)
  1. ; [default: TODAY]
  1. ; ("INCL") = 1: only use pracitioners who were on
  1. ; team for entire date range
  1. ; 0: anytime in date range
  1. ; [default: 1]
  1. ; SCYESCL -boolean[1-yes(default)/0-no] Include pts asc. via enrollment?
  1. ; SCLIST - Name of output array
  1. ; SCERR = array NAME to store error messages.
  1. ; [ex. ^TMP("ORXX",$J
  1. ; Output:
  1. ; SCLIST() = array of practitioners (users) - pointers to file #200
  1. ; Format:
  1. ; Subscript: Sequential # from 1 to n
  1. ; Piece Description
  1. ; 1 IEN of NEW PERSON file entry (#200)
  1. ; 2 .01 of file #200
  1. ; SCERR() = Array of DIALOG file messages(errors) .
  1. ; @SCERR(0)= Number of error(s), UNDEFINED if no errors
  1. ; Foramt:
  1. ; Subscript: Sequential # from 1 to n
  1. ; Piece Description
  1. ; 1 IEN of DIALOG file
  1. ; Returned: 1 if ok, 0 if error
  1. ;
  1. ST N SCOK,SCTM,SCTP,SCX,SCY,NODE,SCZ,SCTPND
  1. N SCLSEQ,SCN,SCESEQ,SCPARM,SCP,SCBEGIN,SCEND,SCINCL,SCDTS
  1. S SCOK=1
  1. ; -- initialize control variables
  1. G:'$$OKDATA MSGQ
  1. ;given patient get list of their teams
  1. S SCOK=$$TMPT^SCAPMC(DFN,SCDATES,,"^TMP(""SCMSG1"",$J)",.SCERR)
  1. G:SCOK<1 MSGQ
  1. ;validate teams
  1. F SCX=1:1 S NODE=$G(^TMP("SCMSG1",$J,SCX)) Q:'NODE S SCTM=+NODE D:$$OKARRAY^SCAPU1(.SCTEAMA,SCTM) Q:SCOK<1
  1. .;given teams get list of their positions
  1. .S SCZ=$$TPTM^SCAPMC(SCTM,SCDATES,,,"^TMP(""SCMSG2"",$J)",.SCERR)
  1. .Q:'SCZ
  1. .IF SCZ<0 S SCOK=-1 Q
  1. .;given list of valid positions get list of practitioners
  1. ; should position get message?
  1. ;;bp/cmf **177** begin
  1. F SCY=1:1 S SCTPND=$G(^TMP("SCMSG2",$J,SCY)) Q:'SCTPND D
  1. .S SCTP=$P(SCTPND,U,1)
  1. .D:$$OKPOS(MSGTYPE,SCTP,DFN,SCYESCL,SCDATES,.SCERR)
  1. ..;given list of valid positions get current practitioners
  1. ..S SCOK=$$PRTP^SCAPMC(SCTP,SCDATES,.SCLIST,.SCERR)
  1. ..Q
  1. .;new code here
  1. .;if preceptor notice turned on for message type
  1. .I +$P($G(^SCTM(404.57,SCTP,2)),U,MSGTYPE+4) D
  1. ..S SCX=+$$OKPREC2^SCMCLK(SCTP,DT)
  1. ..;if preceptor duz returned, add to array
  1. ..I SCX S @SCLIST@("SCPR",SCX)=""
  1. ..Q
  1. .Q
  1. ;
  1. ;;bp/cmf **177** orig begin
  1. ;;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)
  1. ;;o;;.;given list of valid positions get current practitioners
  1. ;;o;;.S SCOK=$$PRTP^SCAPMC(SCTP,SCDATES,.SCLIST,.SCERR)
  1. ;;bp/cmf **177** orig end
  1. ;;bp/cmf **177** end
  1. MSGQ F SCZ="SCMSG1","SCMSG2","SCMSG3" K ^TMP(SCZ)
  1. PRACQ Q $G(@SCERR@(0))<1
  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
  1. ;return 1=ok,0=not ok
  1. N GETMESS,SCOK,SCX,SCTM
  1. K ^TMP("SCMSG3",$J)
  1. S SCTM=$P($G(^SCTM(404.57,SCTP,0)),U,2)
  1. S GETMESS=$P($G(^SCTM(404.57,SCTP,2)),U,MSGTYPE)
  1. S:"T"[GETMESS SCOK=1 ;if null give messages
  1. S:GETMESS="N" SCOK=0
  1. IF GETMESS="P" D
  1. .;check if pt is assigned to position
  1. .S SCX=$$TPPT^SCAPMC(DFN,SCDATES,,,,,SCYESCL,"^TMP(""SCMSG3"",$J)",.SCERR)
  1. .S SCOK=$D(^TMP("SCMSG3",$J,"SCTP",SCTM,SCTP))
  1. .S:SCX<0 SCOK="-1^Error in position-patient call"
  1. K ^TMP("SCMSG3",$J)
  1. Q SCOK
  1. ;
  1. OKDATA() ;setup/check variables
  1. N SCOK
  1. S SCOK=1
  1. D INIT^SCAPMCU1(.SCOK) ; set default dates & error array (if undefined)
  1. S:'$L($G(SCYESCL)) SCYESCL=1
  1. IF '$D(^DPT(+$G(DFN),0)) D S SCOK=0
  1. . S SCPARM("PATIENT")=$G(PATIENT,"Undefined")
  1. . D ERR^SCAPMCU1(.SCESEQ,4045101,.SCPARM,"",.SCERR)
  1. ;
  1. ; -- is it a valid DFN passed (Error # 20001 in DIALOG file)
  1. IF '$D(^DPT(+DFN,0)) D S SCOK=0
  1. . S SCPARM("PATIENT")=DFN
  1. . D ERR^SCAPMCU1(SCESEQ,20001,.SCPARM,"",.SCERR)
  1. Q SCOK
  1. ;
  1. 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
  1. N SCOK,SCGROUP,SC200,SCGROUP
  1. IF '$G(MSGTYPE) S SCOK=0 G QTXMY
  1. S SCOK=1
  1. S SCOK=$$MSGPT(MSGTYPE,.DFN,.SCTEAMA,.SCDATES,.SCYESCL,"^TMP(""SC PCMM MAIL"",$J)")
  1. S SC200=0
  1. F S SC200=$O(^TMP("SC PCMM MAIL",$J,"SCPR",SC200)) Q:'SC200 S XMY(SC200)=""
  1. IF $D(XMY) D
  1. .S XMY(.5)=""
  1. ELSE D
  1. .S SCOK=0
  1. .S XMY(.5)=""
  1. K ^TMP("SC PCMM MAIL",$J)
  1. QTXMY Q SCOK
  1. ;
  1. MSGTEXT(MSGTYPE) ;
  1. Q $S(MSGTYPE=1:"DEATH",(MSGTYPE=2):"INPATIENT",(MSGTYPE=3):"TEAM",(MSGTYPE=4):"CONSULT",(MSGTYPE=5):"INACTIVATION",1:"ERROR")