| 1 | SCMCCON ;ALB/REW - Patient Consult MailMessages ; 26 Mar 1996
|
|---|
| 2 | ;;5.3;Scheduling;**41,87,100,130**;AUG 13, 1993
|
|---|
| 3 | ;1
|
|---|
| 4 | MAIL(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
|
|---|
| 35 | END ;
|
|---|
| 36 | Q
|
|---|
| 37 | ;
|
|---|
| 38 | SETLN(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 | ;
|
|---|
| 45 | TEXT(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)
|
|---|
| 64 | QTTXT Q SCX
|
|---|
