source: FOIAVistA/trunk/r/SCHEDULING-SD-SC/SCMCCON.m@ 1487

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

initial load of FOIAVistA 6/30/08 version

File size: 2.3 KB
Line 
1SCMCCON ;ALB/REW - Patient Consult MailMessages ; 26 Mar 1996
2 ;;5.3;Scheduling;**41,87,100,130**;AUG 13, 1993
3 ;1
4MAIL(DFN,SCCLNM,ENORAP,DATE,SCTMCNA) ;Do Patient Team Changes MailMan Message
5 ; DFN - ien to PATIENT File
6 ; SCCLNM - Name of Clinic
7 ; ENORAP - Enrollment or Appointment? 1=Enrollment, 2=Appointment
8 ; DATE - Date of interest, Default =DT
9 ; SCTMCNA- Array of teams affected
10 ;
11 ; - called by SCMC PT TEAM CHANGES MAIL MESSAGE protocol
12 G:$G(SCNOMAIL) END ;- flag can be set to stop message generation
13 N XMDUZ,XMY,XMSUB,XMTEXT,VA,VAERR,XMZ,Y,SCCNXM
14 N SCTMAR,SCSTAT,SCNODE,SCY,SCSPACE,SCCNDTS,SCSTAT,SCTM
15 S SCCNDTS("BEGIN")=DATE,SCCNDTS("END")=DATE
16 S SCSTAT=$S(ENORAP=1:"Enrollment",(ENORAP=2):"Appointment",1:"")
17 S $P(SCSPACE," ",80)=""
18 ; SCTMAR - ARRAY OF TEAMS (before & after)
19 ;set xmy array for practitioners in positions receiving consult notices
20 G:'$$PCMMXMY^SCAPMC25(4,DFN,SCTMCNA,"SCCMDTS",0) END
21 D:'$G(DGQUIET) EN^DDIOL("Sending Patient-Consult "_SCSTAT_" Message")
22 D PID^VADPT6
23 S SCPTNM=$P(^DPT(DFN,0),U,1)
24 S XMSUB=SCSTAT_" PATIENT-CLINIC "_SCSTAT_" for Patient ("_$E(SCPTNM,1)_VA("BID")_")",XMTEXT="SCCNXM(",SCLNCNT=0
25 D SETLN("This notice is sent because:")
26 D SETLN(" The patient had an "_SCSTAT_" to "_$G(SCCLNM)_" and")
27 D SETLN(" has restricted consults due to the following team assignment(s):")
28 S SCTM=0
29 F S SCTM=$O(@SCTMCNA@(SCTM)) Q:'SCTM D
30 .D SETLN(" "_@SCTMCNA@(SCTM))
31 S SCLNCNT=$$PCMAIL^SCMCMM(DFN,"SCCNXM",DT)
32 S XMDUZ=$G(DUZ,.5)
33 S XMY(XMDUZ)=""
34 D ^XMD
35END ;
36 Q
37 ;
38SETLN(TEXT) ;
39 Q:$G(TEXT)=""
40 ; increments SCLNCNT, adds text to sccnxm(sclncnt)
41 S SCLNCNT=SCLNCNT+1
42 S SCCNXM(SCLNCNT)=TEXT
43 Q
44 ;
45TEXT(SCFILE,SCNODE,SCPC,SCSPACE,SCLAB) ;returns fldname & external value
46 ;returns fldname & external value
47 ; Note- Only works for non wp fields of standard numbering conventions
48 ; SCFLILE =FILENUM
49 ; SCNODE = 0 NODE
50 ; SCPC = piece of node
51 ; SCSPACE = 80 SPACES
52 ; SCLAB = 1 if print field name
53 N SCX,SCINT,SCFLD
54 S SCX=""
55 S SCINT=$P(SCNODE,U,SCPC)
56 G:SCINT="" QTTXT
57 S SCFLD=SCPC*.01
58 ;;;
59 IF $G(SCLAB) D
60 .S SCX=$$DDNAME^SCMCTMM(SCFLD)_":"
61 .S:$G(SCLAB)=1 SCX=SCX_$E(SCSPACE,1,(23-$L(SCX)))
62 .S:$G(SCLAB)=2 SCX=SCX_$E(SCSPACE,1,(50-$L(SCX)))
63 S:SCINT]"" SCX=SCX_$$EXTERNAL^DILFD(SCFILE,SCFLD,"",SCINT)
64QTTXT Q SCX
Note: See TracBrowser for help on using the repository browser.