SCMCPM.m

SCMCPM ;ALB/REW - Inpatient Activity MailMan Message ; 7 Mar 1996

 ;;5.3;Scheduling;**41,87,100,130,1015**;AUG 13, 1993;Build 21

 ;

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

SCMCPM    ;ALB/REW - Inpatient Activity MailMan Message ; 7 Mar 1996

 +1       ;;5.3;Scheduling;**41,87,100,130,1015**;AUG 13, 1993;Build 21

 +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