source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCMCPM.m@ 1361

Last change on this file since 1361 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.0 KB
Line 
1SCMCPM ;ALB/REW - Inpatient Activity MailMan Message ; 7 Mar 1996
2 ;;5.3;Scheduling;**41,87,100,130**;AUG 13, 1993
3 ;
4MAIL ;do Inpatient MailMan Message
5 N SCPMXM,SCPTNM,SCPMDT,SCPCPR,SCPCTM,SCPCAT,SCTRANS,XMDUZ,SCLNCNT,XMY,XMSUB,XMTEXT,VA,VAERR,SCTRANNM,XMZ,Y,SCORIGA,SCNODE,SCPHYND
6 S SCORIGA=$G(^DGPM(+$P(DGPMA,U,14),0))
7 S SCPMDT("BEGIN")=+DGPMA
8 S SCPMDT("END")=DT
9 S SCPMDT("INCL")=0
10 ;set xmy array for practitioners in positions receiving inpt notices
11 G:'$$PCMMXMY^SCAPMC25(2,DFN,,"SCPMDT",0) END
12 S SCTRANS=+$P(DGPMA,U,2),SCTRANNM=$P($G(^DG(405.3,SCTRANS,0)),U,1)
13 G:("^1^2^3^")'[(U_SCTRANS_U) END ;must be admit,transfer or discharge
14 D:'$G(DGQUIET) EN^DDIOL("Sending INPATIENT "_SCTRANNM_" Message")
15 D PID^VADPT6
16 S SCPTNM=$P(^DPT(DFN,0),U,1)
17 S XMSUB="INPATIENT "_SCTRANNM_" for Patient ("_$E(SCPTNM,1)_VA("BID")_")",XMTEXT="SCPMXM(",SCLNCNT=0
18 D SETLN("Patient: "_SCPTNM_"("_VA("PID")_")")
19 D SETLN("Transaction: "_SCTRANNM)
20 S Y=+DGPMA X ^DD("DD") D SETLN("Date/Time: "_Y)
21 ;if movement is not original movement
22 IF DGPMA'=SCORIGA D
23 .S Y=+SCORIGA X ^DD("DD") D SETLN("Admission Date/Time: "_Y)
24 D SETLN("Type of Movement: "_$P($G(^DG(405.1,+$P(DGPMA,U,4),0)),U,1))
25 S SCNODE=$S(SCTRANS=3:DGPMP,1:DGPMA)
26 S VAIP("E")=$S($G(DGPMDA):+DGPMDA,1:$P(SCORIGA,U,14)) D IN5^VADPT
27 S SCPHYND=$S(SCTRANS=3:$G(VAIP(17,5)),1:$G(VAIP(14,5)))
28 D SETLN(" ")
29 D SETLN("Ward Location: "_$S(SCTRANS=3:$P($G(VAIP(17,4)),U,2),1:$P($G(VAIP(14,4)),U,2)))
30 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)))
31 D SETLN("Inpatient Provider: "_$P(SCPHYND,U,2))
32 D SETLN("Admitting DX: "_$P(SCORIGA,U,10))
33 S SCLNCNT=$$PCMAIL^SCMCMM(DFN,"SCPMXM",DT) ;standard pc info into mail
34 S XMDUZ=$G(DUZ,.5)
35 S XMY(XMDUZ)=""
36 D ^XMD
37 D KVAR^VADPT
38END ;
39 Q
40 ;
41SETLN(TEXT) ;
42 ; increments SCLNCNT, adds text to scpmxm(sclncnt)
43 S SCLNCNT=SCLNCNT+1
44 S SCPMXM(SCLNCNT)=TEXT
45 Q
Note: See TracBrowser for help on using the repository browser.