SCMCPM ;ALB/REW - Inpatient Activity MailMan Message ; 7 Mar 1996
;;5.3;Scheduling;**41,87,100,130**;AUG 13, 1993
;
MAIL ;do Inpatient MailMan Message
N SCPMXM,SCPTNM,SCPMDT,SCPCPR,SCPCTM,SCPCAT,SCTRANS,XMDUZ,SCLNCNT,XMY,XMSUB,XMTEXT,VA,VAERR,SCTRANNM,XMZ,Y,SCORIGA,SCNODE,SCPHYND
S SCORIGA=$G(^DGPM(+$P(DGPMA,U,14),0))
S SCPMDT("BEGIN")=+DGPMA
S SCPMDT("END")=DT
S SCPMDT("INCL")=0
;set xmy array for practitioners in positions receiving inpt notices
G:'$$PCMMXMY^SCAPMC25(2,DFN,,"SCPMDT",0) END
S SCTRANS=+$P(DGPMA,U,2),SCTRANNM=$P($G(^DG(405.3,SCTRANS,0)),U,1)
G:("^1^2^3^")'[(U_SCTRANS_U) END ;must be admit,transfer or discharge
D:'$G(DGQUIET) EN^DDIOL("Sending INPATIENT "_SCTRANNM_" Message")
D PID^VADPT6
S SCPTNM=$P(^DPT(DFN,0),U,1)
S XMSUB="INPATIENT "_SCTRANNM_" for Patient ("_$E(SCPTNM,1)_VA("BID")_")",XMTEXT="SCPMXM(",SCLNCNT=0
D SETLN("Patient: "_SCPTNM_"("_VA("PID")_")")
D SETLN("Transaction: "_SCTRANNM)
S Y=+DGPMA X ^DD("DD") D SETLN("Date/Time: "_Y)
;if movement is not original movement
IF DGPMA'=SCORIGA D
.S Y=+SCORIGA X ^DD("DD") D SETLN("Admission Date/Time: "_Y)
D SETLN("Type of Movement: "_$P($G(^DG(405.1,+$P(DGPMA,U,4),0)),U,1))
S SCNODE=$S(SCTRANS=3:DGPMP,1:DGPMA)
S VAIP("E")=$S($G(DGPMDA):+DGPMDA,1:$P(SCORIGA,U,14)) D IN5^VADPT
S SCPHYND=$S(SCTRANS=3:$G(VAIP(17,5)),1:$G(VAIP(14,5)))
D SETLN(" ")
D SETLN("Ward Location: "_$S(SCTRANS=3:$P($G(VAIP(17,4)),U,2),1:$P($G(VAIP(14,4)),U,2)))
D SETLN("Room-Bed: "_$S($L($P($G(^DPT(DFN,.101)),U,1)):$P(^(.101),U,1),1:$P($G(^DG(405.4,+$P(SCNODE,U,7),0)),U,1)))
D SETLN("Inpatient Provider: "_$P(SCPHYND,U,2))
D SETLN("Admitting DX: "_$P(SCORIGA,U,10))
S SCLNCNT=$$PCMAIL^SCMCMM(DFN,"SCPMXM",DT) ;standard pc info into mail
S XMDUZ=$G(DUZ,.5)
S XMY(XMDUZ)=""
D ^XMD
D KVAR^VADPT
END ;
Q
;
SETLN(TEXT) ;
; increments SCLNCNT, adds text to scpmxm(sclncnt)
S SCLNCNT=SCLNCNT+1
S SCPMXM(SCLNCNT)=TEXT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCMCPM 2055 printed Oct 16, 2024@18:41:44 Page 2
SCMCPM ;ALB/REW - Inpatient Activity MailMan Message ; 7 Mar 1996
+1 ;;5.3;Scheduling;**41,87,100,130**;AUG 13, 1993
+2 ;
MAIL ;do Inpatient MailMan Message
+1 NEW SCPMXM,SCPTNM,SCPMDT,SCPCPR,SCPCTM,SCPCAT,SCTRANS,XMDUZ,SCLNCNT,XMY,XMSUB,XMTEXT,VA,VAERR,SCTRANNM,XMZ,Y,SCORIGA,SCNODE,SCPHYND
+2 SET SCORIGA=$GET(^DGPM(+$PIECE(DGPMA,U,14),0))
+3 SET SCPMDT("BEGIN")=+DGPMA
+4 SET SCPMDT("END")=DT
+5 SET SCPMDT("INCL")=0
+6 ;set xmy array for practitioners in positions receiving inpt notices
+7 if '$$PCMMXMY^SCAPMC25(2,DFN,,"SCPMDT",0)
GOTO END
+8 SET SCTRANS=+$PIECE(DGPMA,U,2)
SET SCTRANNM=$PIECE($GET(^DG(405.3,SCTRANS,0)),U,1)
+9 ;must be admit,transfer or discharge
if ("^1^2^3^")'[(U_SCTRANS_U)
GOTO END
+10 if '$GET(DGQUIET)
DO EN^DDIOL("Sending INPATIENT "_SCTRANNM_" Message")
+11 DO PID^VADPT6
+12 SET SCPTNM=$PIECE(^DPT(DFN,0),U,1)
+13 SET XMSUB="INPATIENT "_SCTRANNM_" for Patient ("_$EXTRACT(SCPTNM,1)_VA("BID")_")"
SET XMTEXT="SCPMXM("
SET SCLNCNT=0
+14 DO SETLN("Patient: "_SCPTNM_"("_VA("PID")_")")
+15 DO SETLN("Transaction: "_SCTRANNM)
+16 SET Y=+DGPMA
XECUTE ^DD("DD")
DO SETLN("Date/Time: "_Y)
+17 ;if movement is not original movement
+18 IF DGPMA'=SCORIGA
Begin DoDot:1
+19 SET Y=+SCORIGA
XECUTE ^DD("DD")
DO SETLN("Admission Date/Time: "_Y)
End DoDot:1
+20 DO SETLN("Type of Movement: "_$PIECE($GET(^DG(405.1,+$PIECE(DGPMA,U,4),0)),U,1))
+21 SET SCNODE=$SELECT(SCTRANS=3:DGPMP,1:DGPMA)
+22 SET VAIP("E")=$SELECT($GET(DGPMDA):+DGPMDA,1:$PIECE(SCORIGA,U,14))
DO IN5^VADPT
+23 SET SCPHYND=$SELECT(SCTRANS=3:$GET(VAIP(17,5)),1:$GET(VAIP(14,5)))
+24 DO SETLN(" ")
+25 DO SETLN("Ward Location: "_$SELECT(SCTRANS=3:$PIECE($GET(VAIP(17,4)),U,2),1:$PIECE($GET(VAIP(14,4)),U,2)))
+26 DO SETLN("Room-Bed: "_$SELECT($LENGTH($PIECE($GET(^DPT(DFN,.101)),U,1)):$PIECE(^(.101),U,1),1:$PIECE($GET(^DG(405.4,+$PIECE(SCNODE,U,7),0)),U,1)))
+27 DO SETLN("Inpatient Provider: "_$PIECE(SCPHYND,U,2))
+28 DO SETLN("Admitting DX: "_$PIECE(SCORIGA,U,10))
+29 ;standard pc info into mail
SET SCLNCNT=$$PCMAIL^SCMCMM(DFN,"SCPMXM",DT)
+30 SET XMDUZ=$GET(DUZ,.5)
+31 SET XMY(XMDUZ)=""
+32 DO ^XMD
+33 DO KVAR^VADPT
END ;
+1 QUIT
+2 ;
SETLN(TEXT) ;
+1 ; increments SCLNCNT, adds text to scpmxm(sclncnt)
+2 SET SCLNCNT=SCLNCNT+1
+3 SET SCPMXM(SCLNCNT)=TEXT
+4 QUIT
