| 1 | SCMCTMM ;ALB/REW - Patient Team Changes MailMessages ; 26 Mar 1996
|
---|
| 2 | ;;5.3;Scheduling;**41,45,87,100,130,177**;AUG 13, 1993
|
---|
| 3 | ;1
|
---|
| 4 | MAIL ;Do Patient Team Changes MailMan Message
|
---|
| 5 | ; - called by SCMC PT TEAM CHANGES MAIL MESSAGE protocol
|
---|
| 6 | G:$G(SCNOMAIL) END ;- flag can be set to stop message generation
|
---|
| 7 | N XMDUZ,XMY,XMSUB,XMTEXT,VA,VAERR,XMZ,Y,SCX,ZTQUEUED
|
---|
| 8 | N SCTMAR,SCSTAT,DFN,SCNODE,SCY,SCSPACE,SCPAD,SCPHONE,SCB,SCE,SCB2,SCE2,SCTMDT,SCTMXM,SCPTNM,SCLNCNT
|
---|
| 9 | S ZTQUEUED=1
|
---|
| 10 | S $P(SCSPACE," ",80)=""
|
---|
| 11 | ; SCTMAR - ARRAY OF TEAMS (before & after)
|
---|
| 12 | S:SCTMB4 SCTMAR(SCTMB4)=""
|
---|
| 13 | S:SCTMAF SCTMAR(SCTMAF)=""
|
---|
| 14 | IF 'SCTMAF D
|
---|
| 15 | .S SCSTAT="DELETED",SCB=$P(SCTMB4,U,2),SCE=$S($P(SCPTTMB4,U,9):$P(SCPTTMB4,U,9),1:DT)
|
---|
| 16 | IF 'SCTMB4 D
|
---|
| 17 | .S SCSTAT="NEW",SCB=$P(SCTMAF,U,2),SCE=$S($P(SCPTTMAF,U,9):$P(SCPTTMAF,U,9),1:DT)
|
---|
| 18 | IF SCTMB4&SCTMAF D
|
---|
| 19 | .S SCSTAT="CHANGED"
|
---|
| 20 | .S SCB=$P(SCTMB4,U,2),SCE=$S($P(SCPTTMB4,U,9):$P(SCPTTMB4,U,9),1:DT)
|
---|
| 21 | .S SCB2=$P(SCTMAF,U,2),SCE2=$S($P(SCPTTMAF,U,9):$P(SCPTTMAF,U,9),1:DT)
|
---|
| 22 | .S SCTMDT("BEGIN")=$S(SCB<SCB2:SCB,1:SCB2)
|
---|
| 23 | .S SCTMDT("END")=$S(SCE>SCE2:SCE,1:SCE2)
|
---|
| 24 | .S SCTMDT("INCL")=0
|
---|
| 25 | IF SCSTAT="NEW"!(SCSTAT="DELETED") D
|
---|
| 26 | .S SCTMDT("BEGIN")=SCB
|
---|
| 27 | .S SCTMDT("END")=SCE
|
---|
| 28 | .S SCTMDT("INCL")=0
|
---|
| 29 | S DFN=$S(SCSTAT="DELETED":+SCPTTMB4,1:+SCPTTMAF)
|
---|
| 30 | ;set xmy array for practitioners in positions receiving tmchg notices
|
---|
| 31 | G:'$$PCMMXMY^SCAPMC25(3,DFN,"SCTMAR","SCTMDT",0) END
|
---|
| 32 | D:'$G(DGQUIET) EN^DDIOL("Sending "_SCSTAT_" Patient-Team Assignment Message")
|
---|
| 33 | D PID^VADPT6
|
---|
| 34 | S SCPTNM=$P(^DPT(DFN,0),U,1)
|
---|
| 35 | S XMSUB=SCSTAT_" PATIENT-TEAM ASSIGNMENT for Patient ("_$E(SCPTNM,1)_$G(VA("BID"))_")",XMTEXT="^TMP($J,""SCTMXM"",",SCLNCNT=0
|
---|
| 36 | IF SCSTAT="NEW" D
|
---|
| 37 | .D SETLN("Current Patient Team Data:")
|
---|
| 38 | .D SETLN("==========================")
|
---|
| 39 | .F SCX=1:1:14 D
|
---|
| 40 | ..D SETLN($$TEXT(404.42,SCPTTMAF,SCX,SCSPACE,1))
|
---|
| 41 | IF SCSTAT="DELETED" D
|
---|
| 42 | .D SETLN("Previous Patient Team Data:")
|
---|
| 43 | .D SETLN("===========================")
|
---|
| 44 | .F SCX=1:1:14 S SCFLD=SCX*.01 D
|
---|
| 45 | ..D SETLN($$TEXT(404.42,SCPTTMB4,SCX,SCSPACE,1))
|
---|
| 46 | IF SCSTAT="CHANGED" D
|
---|
| 47 | .D SETLN("Fields: "_$E(SCSPACE,1,15)_"Previous Data: Current Patient Data:")
|
---|
| 48 | .D SETLN("=======================================================================")
|
---|
| 49 | .F SCX=1:1:14 S SCFLD=SCX*.01 D
|
---|
| 50 | ..N SCLAB2,SCY,SCZ
|
---|
| 51 | ..S SCY=$$TEXT(404.42,SCPTTMB4,SCX,SCSPACE,1)
|
---|
| 52 | ..S:'$L(SCY) SCLAB2=2
|
---|
| 53 | ..S SCZ=$$TEXT(404.42,SCPTTMAF,SCX,SCSPACE,+$G(SCLAB2))
|
---|
| 54 | ..D:$L(SCY)!($L(SCZ)) SETLN(SCY_$E(SCSPACE,1,(50-$L(SCY)))_SCZ)
|
---|
| 55 | S SCLNCNT=$$PCMAIL^SCMCMM(DFN,"^TMP($J,""SCTMXM"")",DT)
|
---|
| 56 | S XMDUZ=$G(DUZ,.5)
|
---|
| 57 | S XMY(XMDUZ)=""
|
---|
| 58 | D ^XMD
|
---|
| 59 | END K ^TMP($J,"SCTMXM")
|
---|
| 60 | Q
|
---|
| 61 | ;
|
---|
| 62 | SETLN(TEXT) ;
|
---|
| 63 | Q:$G(TEXT)=""
|
---|
| 64 | ; increments SCLNCNT, adds text to sctmxm(sclncnt)
|
---|
| 65 | S SCLNCNT=SCLNCNT+1
|
---|
| 66 | S ^TMP($J,"SCTMXM",SCLNCNT)=TEXT
|
---|
| 67 | Q
|
---|
| 68 | ;
|
---|
| 69 | TEXT(SCFILE,SCNODE,SCPC,SCSPACE,SCLAB) ;returns fldname & external value
|
---|
| 70 | ;returns fldname & external value
|
---|
| 71 | ; Note- Only works for non wp fields of standard numbering conventions
|
---|
| 72 | ; SCFLILE =FILENUM
|
---|
| 73 | ; SCNODE = 0 NODE
|
---|
| 74 | ; SCPC = piece of node
|
---|
| 75 | ; SCSPACE = 80 SPACES
|
---|
| 76 | ; SCLAB = 1 if print field name
|
---|
| 77 | N SCX,SCINT,SCFLD
|
---|
| 78 | S SCX=""
|
---|
| 79 | S SCINT=$P(SCNODE,U,SCPC)
|
---|
| 80 | G:SCINT="" QTTXT
|
---|
| 81 | S SCFLD=SCPC*.01
|
---|
| 82 | ;;;
|
---|
| 83 | IF $G(SCLAB) D
|
---|
| 84 | .S SCX=$$DDNAME(SCFILE,SCFLD)_":"
|
---|
| 85 | .S:$G(SCLAB)=1 SCX=SCX_$E(SCSPACE,1,(23-$L(SCX)))
|
---|
| 86 | .S:$G(SCLAB)=2 SCX=SCX_$E(SCSPACE,1,(50-$L(SCX)))
|
---|
| 87 | S:SCINT]"" SCX=SCX_$$EXTERNAL^DILFD(SCFILE,SCFLD,"",SCINT)
|
---|
| 88 | ;adding SSN to the end of name for alpha 177
|
---|
| 89 | I $P(SCX,":",1)="PATIENT" S SCX=SCX_" ("_$G(VA("PID"))_")"
|
---|
| 90 | QTTXT Q SCX
|
---|
| 91 | ;
|
---|
| 92 | DDNAME(FILE,FIELD) ;return the fieldname
|
---|
| 93 | N SCX
|
---|
| 94 | D FIELD^DID(FILE,FIELD,"","LABEL","SCX")
|
---|
| 95 | Q $G(SCX("LABEL"))
|
---|
| 96 | ;
|
---|
| 97 | MAILLST(SCTM,SCFIELDA,SCDATE,SCNEWTM,SCOLDTM,SCBADTM) ;
|
---|
| 98 | ; Input:
|
---|
| 99 | ; SCTM - Pointer to Team File (#404.51)
|
---|
| 100 | ; SCFIELDA - Field array with internal values
|
---|
| 101 | ; SCDATE - Effective Date
|
---|
| 102 | ; SCNEWTM - DFN array of newly assigned to team
|
---|
| 103 | ; SCOLDTM - DFN array of previously assigned to team
|
---|
| 104 | ; SCBADTM - DFN array of patients unassignable to team
|
---|
| 105 | ;
|
---|
| 106 | G:$G(SCNOMAIL) QTMULT ;- flag can be set to stop message generation
|
---|
| 107 | G:'$D(SCNEWTM) QTMULT
|
---|
| 108 | G:'$O(@SCNEWTM@(0)) QTMULT ;if no new assignments
|
---|
| 109 | N XMDUZ,XMY,XMSUB,XMTEXT,VA,VAERR,XMZ,Y,ZTQUEUED
|
---|
| 110 | N SCTMNM,DFN,SCOK,SCPTNM,SCFLD,SCNODE,SCNDX,SCSPACE,SCE,SCB,SCTMDT,SCDELTEM
|
---|
| 111 | S ZTQUEUED=1
|
---|
| 112 | S SCDELTEM=1 ;ok to delete tmp global
|
---|
| 113 | IF $D(SCFIELDA) D
|
---|
| 114 | .IF $D(SCFIELDA(.02)) S SCB=SCFIELDA(.02)
|
---|
| 115 | .IF $D(SCFIELDA(.09)) S SCE=SCFIELDA(.09)
|
---|
| 116 | S SCB=$G(SCB,DT)
|
---|
| 117 | S SCE=$G(SCE,DT)
|
---|
| 118 | S $P(SCSPACE," ",80)=""
|
---|
| 119 | S SCTMDT("BEGIN")=$S(SCB<SCDATE:SCB,1:SCDATE)
|
---|
| 120 | S SCTMDT("END")=$S(SCE>SCDATE:SCE,1:SCDATE)
|
---|
| 121 | S SCTMDT("INCL")=0
|
---|
| 122 | S SCTMNM=$P($G(^SCTM(404.51,+SCTM,0)),U,1)
|
---|
| 123 | S XMSUB="Multiple PATIENT-TEAM ASSIGNMENT for "_SCTMNM,XMTEXT="^TMP($J,""SCTMXM"",",SCLNCNT=0
|
---|
| 124 | D:'$G(DGQUIET) EN^DDIOL("Sending Multiple Patient-Team Assignment Message")
|
---|
| 125 | S SCOK=1
|
---|
| 126 | S SCTMNM=$P($G(^SCTM(404.51,+SCTM,0)),U,1)
|
---|
| 127 | D SETLN("Team: "_SCTMNM)
|
---|
| 128 | S Y=SCDATE X ^DD("DD")
|
---|
| 129 | D SETLN("Effective Date: "_Y)
|
---|
| 130 | D SETLN(" ")
|
---|
| 131 | IF $D(SCFIELDA) D
|
---|
| 132 | .F SCNDX=1:1:14 S SCFLD=SCNDX*.01 IF $D(SCFIELDA(SCFLD)) D
|
---|
| 133 | ..S $P(SCNODE,U,SCNDX)=SCFIELDA(SCFLD)
|
---|
| 134 | ..D SETLN($$TEXT(404.42,SCNODE,SCNDX,SCSPACE,1))
|
---|
| 135 | D SETLN(" ")
|
---|
| 136 | D SETLN("There has been a new team assignment for the following patients:")
|
---|
| 137 | S DFN=0
|
---|
| 138 | F S DFN=$O(@SCNEWTM@(DFN)) Q:'DFN D
|
---|
| 139 | .S:$$PCMMXMY^SCAPMC25(3,DFN,,"SCTMDT",0) SCOK=0
|
---|
| 140 | .D PID^VADPT6
|
---|
| 141 | .S SCPTNM=$P(^DPT(DFN,0),U,1)
|
---|
| 142 | .S ^TMP("SCTM MAIL LST",$J,SCTM,1,DFN)=(" "_SCPTNM_" ("_$G(VA("PID"))_")")
|
---|
| 143 | .S ^TMP("SCTM MAIL LST",$J,SCTM,1,"B",SCPTNM,DFN)=""
|
---|
| 144 | S SCPTNM=""
|
---|
| 145 | F S SCPTNM=$O(^TMP("SCTM MAIL LST",$J,SCTM,1,"B",SCPTNM)) Q:SCPTNM']"" D
|
---|
| 146 | .S DFN=0
|
---|
| 147 | .F S DFN=$O(^TMP("SCTM MAIL LST",$J,SCTM,1,"B",SCPTNM,DFN)) Q:'DFN D
|
---|
| 148 | ..S SCDETAIL=$G(^TMP("SCTM MAIL LST",$J,SCTM,1,DFN)) Q:SCDETAIL']"" D SETLN(SCDETAIL)
|
---|
| 149 | BAD IF $S('$D(SCBADTM):0,1:$O(@SCBADTM@(0))) D
|
---|
| 150 | .D SETLN(" ")
|
---|
| 151 | .D SETLN("There has been NO new team assignment for the following patients:")
|
---|
| 152 | .S DFN=0
|
---|
| 153 | .F S DFN=$O(@SCBADTM@(DFN)) Q:'DFN D
|
---|
| 154 | ..S:$$PCMMXMY^SCAPMC25(3,DFN,,"SCTMDT",0) SCOK=0
|
---|
| 155 | ..S SCPTNM=$P(^DPT(DFN,0),U,1)
|
---|
| 156 | ..D PID^VADPT6
|
---|
| 157 | ..S ^TMP("SCTM MAIL LST",$J,SCTM,2,DFN)=(" "_SCPTNM_" ("_$G(VA("PID"))_")")
|
---|
| 158 | ..S ^TMP("SCTM MAIL LST",$J,SCTM,2,"B",SCPTNM,DFN)=""
|
---|
| 159 | .S SCPTNM=""
|
---|
| 160 | .F S SCPTNM=$O(^TMP("SCTM MAIL LST",$J,SCTM,2,"B",SCPTNM)) Q:SCPTNM']"" D
|
---|
| 161 | ..S DFN=0
|
---|
| 162 | ..F S DFN=$O(^TMP("SCTM MAIL LST",$J,SCTM,2,"B",SCPTNM,DFN)) Q:'DFN D
|
---|
| 163 | ...S SCDETAIL=$G(^TMP("SCTM MAIL LST",$J,SCTM,2,DFN)) Q:SCDETAIL']"" D SETLN(SCDETAIL)
|
---|
| 164 | S XMDUZ=$G(DUZ,.5)
|
---|
| 165 | D ^XMD
|
---|
| 166 | QTMULT K:$G(SCDELTEM) ^TMP("SCTM MAIL LST",$J,SCTM)
|
---|
| 167 | K ^TMP($J,"SCTMXM")
|
---|
| 168 | Q
|
---|