PSUDEM5 ;BIR/DAM - Patient Demographics Mail Messages ; 20 DEC 2001
;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
;
PDMAIL ;EN Mail patient demographics message
;
Q:$D(^XTMP("PSU_"_PSUJOB,"PSUFLAG3")) ;don't send a mailman message if flag is set
I '$D(^XTMP("PSU_"_PSUJOB,"PSUMONTH")) D AUTO ;Find month if auto extract
;
D VAR
S PSUST=$P(^XTMP("PSU_"_PSUJOB,"PSUSITE"),U,1)
S PSUSTNM=$P(^XTMP("PSU_"_PSUJOB,"PSUSITE"),U,2)
S PSUMON=$P(^XTMP("PSU_"_PSUJOB,"PSUMONTH"),U,1)
I $G(^XTMP("PSU_"_PSUJOB,"REXMIT"))="YES" S PSUMON=PSURMON
S XMDUZ=DUZ
S XMSUB="V. 4.0 PBMPD"_" "_PSUMON_" "_PSUM_"/"_PSUMC_" "_PSUST_" "_PSUSTNM
S XMCHAN=1
;S PSUPBMG=^XTMP("PSU_"_PSUJOB,"PSUPBMG")
S XMTEXT="^XTMP(""PSU_""_PSUJOB,""PSUXMD"",PSUM,"
I PSUMASF!PSUDUZ!PSUPBMG D
.I 'PSUSMRY M XMY=PSUXMYH D ;Detailed message to Hines and self
.D ^XMD
Q
;
AUTO ;Find month if auto extract is run
;
D NOW^%DTC S PSUMON=$S('$D(DT):X,1:DT),PSUMON=$E(PSUMON,1,5)-1 ;Prior mt
I $E(PSUMON,4,5)="00" S PSUMON=($E(PSUMON,1,3)-1)_"12"
S ^XTMP("PSU_"_PSUJOB,"PSUMONTH")=PSUMON
Q
;
VAR ;Get variables common to all extract messages
;
N PSUSTNM,PSUST,PSUMON
D INST^PSUDEM1
;
Q
;
PROV ;EN Mail Provider message
;
Q:$D(^XTMP("PSU_"_PSUJOB,"PSUFLAG3")) ;don't send a mailman message if flag is set
I '$D(^XTMP("PSU_"_PSUJOB,"PSUMONTH")) D AUTO ;Find month if auto
D VAR
S PSUST=$P(^XTMP("PSU_"_PSUJOB,"PSUSITE"),U,1)
S PSUSTNM=$P(^XTMP("PSU_"_PSUJOB,"PSUSITE"),U,2)
S PSUMON=$P(^XTMP("PSU_"_PSUJOB,"PSUMONTH"),U,1)
;
S XMCHAN=1
S XMDUZ=DUZ
S XMSUB="V. 4.0 PBMPRO"_" "_PSUMON_" "_PSUM_"/"_PSUMC_" "_PSUST_" "_PSUSTNM
S XMTEXT="^XTMP(""PSU_""_PSUJOB,""PSUXMD"",PSUM,"
I PSUMASF!PSUDUZ!PSUPBMG D
.I 'PSUSMRY M XMY=PSUXMYH D ;Detailed message to Hines and self
.D ^XMD
Q
;
OPV ;EN Outpatient encounter message
;
Q:$D(^XTMP("PSU_"_PSUJOB,"PSUFLAG3")) ;don't send a mailman message if flag is set
I '$D(^XTMP("PSU_"_PSUJOB,"PSUMONTH")) D AUTO ;Find month if auto
D VAR
S PSUST=$P(^XTMP("PSU_"_PSUJOB,"PSUSITE"),U,1)
S PSUSTNM=$P(^XTMP("PSU_"_PSUJOB,"PSUSITE"),U,2)
S PSUMON=$P(^XTMP("PSU_"_PSUJOB,"PSUMONTH"),U,1)
I '$D(^XTMP("PSU_"_PSUJOB,"PSUOPV")) S PSUMC=1
;
S XMDUZ=DUZ
S XMSUB="V. 4.0 PBMOV"_" "_PSUMON_" "_PSUM_"/"_PSUMC_" "_PSUST_" "_PSUSTNM
S XMCHAN=1
S XMTEXT="^XTMP(""PSU_""_PSUJOB,""PSUXMD"",PSUM,"
I PSUMASF!PSUDUZ!PSUPBMG D
.I 'PSUSMRY M XMY=PSUXMYH D ;Detailed message to Hines and self
.D ^XMD
I '$D(^XTMP("PSU_"_PSUJOB,"PSUOPV")) M XMY=PSUXMYS1 D ;NODATA message
.D ^XMD
;K ^XTMP("PSU_"_PSUJOB,"PSUMONTH")
Q
;
PTF ;EN INPATIENT RECORD MESSAGE
;
Q:$D(^XTMP("PSU_"_PSUJOB,"PSUFLAG3")) ;don't send a mailman message if flag is set
I '$D(^XTMP("PSU_"_PSUJOB,"PSUMONTH")) D AUTO ;Find month if auto
D VAR
S PSUST=$P(^XTMP("PSU_"_PSUJOB,"PSUSITE"),U,1)
S PSUSTNM=$P(^XTMP("PSU_"_PSUJOB,"PSUSITE"),U,2)
S PSUMON=$P(^XTMP("PSU_"_PSUJOB,"PSUMONTH"),U,1)
I '$D(^XTMP("PSU_"_PSUJOB,"PSUIPV")) S PSUMC=1
;
S XMDUZ=DUZ
S XMSUB="V. 4.0 PBMPTF"_" "_PSUMON_" "_PSUM_"/"_PSUMC_" "_PSUST_" "_PSUSTNM
S XMCHAN=1
S XMTEXT="^XTMP(""PSU_""_PSUJOB,""PSUXMD"",PSUM,"
I PSUMASF!PSUDUZ!PSUPBMG D
.I 'PSUSMRY M XMY=PSUXMYH D ;Detailed message to Hines and self
.D ^XMD
I '$D(^XTMP("PSU_"_PSUJOB,"PSUIPV")) M XMY=PSUXMYS1 D ;NODATA message
.D ^XMD
Q
;
PRSUM ;EN Provider summary message
;
Q:$D(^XTMP("PSU_"_PSUJOB,"PSUFLAG3")) ;don't send a mailman message if flag is set
I '$D(^XTMP("PSU_"_PSUJOB,"PSUMONTH")) D AUTO ;Find month if auto
D VAR
S PSUST=$P(^XTMP("PSU_"_PSUJOB,"PSUSITE"),U,1)
S PSUSTNM=$P(^XTMP("PSU_"_PSUJOB,"PSUSITE"),U,2)
S PSUMON=$P(^XTMP("PSU_"_PSUJOB,"PSUMONTH"),U,1)
;
S XMDUZ=DUZ
S XMCHAN=1
S XMSUB="V. 4.0 PBMPRO"_" "_PSUMON_" "_PSUST_" "_PSUSTNM
S XMTEXT="^XTMP(""PSU_""_PSUJOB,""PSUSUM"","
M XMY=PSUXMYS1
I PSUSMRY=1 M XMY=PSUXMYS2 ;Summary only mailgroup
D ^XMD
Q
;
PDSUM ;EN Pt. demographics summary message
;
Q:$D(^XTMP("PSU_"_PSUJOB,"PSUFLAG3")) ;don't send a mailman message if flag is set
;N PSUSTNM,PSUST
D PULL^PSUCP
I '$D(^XTMP("PSU_"_PSUJOB,"PSUMONTH")) D AUTO ;Find month if auto
D VAR
S PSUST=$P(^XTMP("PSU_"_PSUJOB,"PSUSITE"),U,1)
S PSUSTNM=$P(^XTMP("PSU_"_PSUJOB,"PSUSITE"),U,2)
S PSUMON=$P(^XTMP("PSU_"_PSUJOB,"PSUMONTH"),U,1)
;
S XMDUZ=DUZ
S XMCHAN=1
S XMSUB="V. 4.0 PBMPD"_" "_PSUMON_" "_PSUST_" "_PSUSTNM
S XMTEXT="^XTMP(""PSU_""_PSUJOB,""PSUSUMA"","
I PSUSMRY=1 M XMY=PSUXMYS2 ;Summary only mailgroup
M XMY=PSUXMYS1 ;No Data mailgroup
D ^XMD
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSUDEM5 4647 printed Oct 16, 2024@18:28:30 Page 2
PSUDEM5 ;BIR/DAM - Patient Demographics Mail Messages ; 20 DEC 2001
+1 ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
+2 ;
PDMAIL ;EN Mail patient demographics message
+1 ;
+2 ;don't send a mailman message if flag is set
if $DATA(^XTMP("PSU_"_PSUJOB,"PSUFLAG3"))
QUIT
+3 ;Find month if auto extract
IF '$DATA(^XTMP("PSU_"_PSUJOB,"PSUMONTH"))
DO AUTO
+4 ;
+5 DO VAR
+6 SET PSUST=$PIECE(^XTMP("PSU_"_PSUJOB,"PSUSITE"),U,1)
+7 SET PSUSTNM=$PIECE(^XTMP("PSU_"_PSUJOB,"PSUSITE"),U,2)
+8 SET PSUMON=$PIECE(^XTMP("PSU_"_PSUJOB,"PSUMONTH"),U,1)
+9 IF $GET(^XTMP("PSU_"_PSUJOB,"REXMIT"))="YES"
SET PSUMON=PSURMON
+10 SET XMDUZ=DUZ
+11 SET XMSUB="V. 4.0 PBMPD"_" "_PSUMON_" "_PSUM_"/"_PSUMC_" "_PSUST_" "_PSUSTNM
+12 SET XMCHAN=1
+13 ;S PSUPBMG=^XTMP("PSU_"_PSUJOB,"PSUPBMG")
+14 SET XMTEXT="^XTMP(""PSU_""_PSUJOB,""PSUXMD"",PSUM,"
+15 IF PSUMASF!PSUDUZ!PSUPBMG
Begin DoDot:1
+16 ;Detailed message to Hines and self
IF 'PSUSMRY
MERGE XMY=PSUXMYH
Begin DoDot:2
End DoDot:2
+17 DO ^XMD
End DoDot:1
+18 QUIT
+19 ;
AUTO ;Find month if auto extract is run
+1 ;
+2 ;Prior mt
DO NOW^%DTC
SET PSUMON=$SELECT('$DATA(DT):X,1:DT)
SET PSUMON=$EXTRACT(PSUMON,1,5)-1
+3 IF $EXTRACT(PSUMON,4,5)="00"
SET PSUMON=($EXTRACT(PSUMON,1,3)-1)_"12"
+4 SET ^XTMP("PSU_"_PSUJOB,"PSUMONTH")=PSUMON
+5 QUIT
+6 ;
VAR ;Get variables common to all extract messages
+1 ;
+2 NEW PSUSTNM,PSUST,PSUMON
+3 DO INST^PSUDEM1
+4 ;
+5 QUIT
+6 ;
PROV ;EN Mail Provider message
+1 ;
+2 ;don't send a mailman message if flag is set
if $DATA(^XTMP("PSU_"_PSUJOB,"PSUFLAG3"))
QUIT
+3 ;Find month if auto
IF '$DATA(^XTMP("PSU_"_PSUJOB,"PSUMONTH"))
DO AUTO
+4 DO VAR
+5 SET PSUST=$PIECE(^XTMP("PSU_"_PSUJOB,"PSUSITE"),U,1)
+6 SET PSUSTNM=$PIECE(^XTMP("PSU_"_PSUJOB,"PSUSITE"),U,2)
+7 SET PSUMON=$PIECE(^XTMP("PSU_"_PSUJOB,"PSUMONTH"),U,1)
+8 ;
+9 SET XMCHAN=1
+10 SET XMDUZ=DUZ
+11 SET XMSUB="V. 4.0 PBMPRO"_" "_PSUMON_" "_PSUM_"/"_PSUMC_" "_PSUST_" "_PSUSTNM
+12 SET XMTEXT="^XTMP(""PSU_""_PSUJOB,""PSUXMD"",PSUM,"
+13 IF PSUMASF!PSUDUZ!PSUPBMG
Begin DoDot:1
+14 ;Detailed message to Hines and self
IF 'PSUSMRY
MERGE XMY=PSUXMYH
Begin DoDot:2
End DoDot:2
+15 DO ^XMD
End DoDot:1
+16 QUIT
+17 ;
OPV ;EN Outpatient encounter message
+1 ;
+2 ;don't send a mailman message if flag is set
if $DATA(^XTMP("PSU_"_PSUJOB,"PSUFLAG3"))
QUIT
+3 ;Find month if auto
IF '$DATA(^XTMP("PSU_"_PSUJOB,"PSUMONTH"))
DO AUTO
+4 DO VAR
+5 SET PSUST=$PIECE(^XTMP("PSU_"_PSUJOB,"PSUSITE"),U,1)
+6 SET PSUSTNM=$PIECE(^XTMP("PSU_"_PSUJOB,"PSUSITE"),U,2)
+7 SET PSUMON=$PIECE(^XTMP("PSU_"_PSUJOB,"PSUMONTH"),U,1)
+8 IF '$DATA(^XTMP("PSU_"_PSUJOB,"PSUOPV"))
SET PSUMC=1
+9 ;
+10 SET XMDUZ=DUZ
+11 SET XMSUB="V. 4.0 PBMOV"_" "_PSUMON_" "_PSUM_"/"_PSUMC_" "_PSUST_" "_PSUSTNM
+12 SET XMCHAN=1
+13 SET XMTEXT="^XTMP(""PSU_""_PSUJOB,""PSUXMD"",PSUM,"
+14 IF PSUMASF!PSUDUZ!PSUPBMG
Begin DoDot:1
+15 ;Detailed message to Hines and self
IF 'PSUSMRY
MERGE XMY=PSUXMYH
Begin DoDot:2
End DoDot:2
+16 DO ^XMD
End DoDot:1
+17 ;NODATA message
IF '$DATA(^XTMP("PSU_"_PSUJOB,"PSUOPV"))
MERGE XMY=PSUXMYS1
Begin DoDot:1
+18 DO ^XMD
End DoDot:1
+19 ;K ^XTMP("PSU_"_PSUJOB,"PSUMONTH")
+20 QUIT
+21 ;
PTF ;EN INPATIENT RECORD MESSAGE
+1 ;
+2 ;don't send a mailman message if flag is set
if $DATA(^XTMP("PSU_"_PSUJOB,"PSUFLAG3"))
QUIT
+3 ;Find month if auto
IF '$DATA(^XTMP("PSU_"_PSUJOB,"PSUMONTH"))
DO AUTO
+4 DO VAR
+5 SET PSUST=$PIECE(^XTMP("PSU_"_PSUJOB,"PSUSITE"),U,1)
+6 SET PSUSTNM=$PIECE(^XTMP("PSU_"_PSUJOB,"PSUSITE"),U,2)
+7 SET PSUMON=$PIECE(^XTMP("PSU_"_PSUJOB,"PSUMONTH"),U,1)
+8 IF '$DATA(^XTMP("PSU_"_PSUJOB,"PSUIPV"))
SET PSUMC=1
+9 ;
+10 SET XMDUZ=DUZ
+11 SET XMSUB="V. 4.0 PBMPTF"_" "_PSUMON_" "_PSUM_"/"_PSUMC_" "_PSUST_" "_PSUSTNM
+12 SET XMCHAN=1
+13 SET XMTEXT="^XTMP(""PSU_""_PSUJOB,""PSUXMD"",PSUM,"
+14 IF PSUMASF!PSUDUZ!PSUPBMG
Begin DoDot:1
+15 ;Detailed message to Hines and self
IF 'PSUSMRY
MERGE XMY=PSUXMYH
Begin DoDot:2
End DoDot:2
+16 DO ^XMD
End DoDot:1
+17 ;NODATA message
IF '$DATA(^XTMP("PSU_"_PSUJOB,"PSUIPV"))
MERGE XMY=PSUXMYS1
Begin DoDot:1
+18 DO ^XMD
End DoDot:1
+19 QUIT
+20 ;
PRSUM ;EN Provider summary message
+1 ;
+2 ;don't send a mailman message if flag is set
if $DATA(^XTMP("PSU_"_PSUJOB,"PSUFLAG3"))
QUIT
+3 ;Find month if auto
IF '$DATA(^XTMP("PSU_"_PSUJOB,"PSUMONTH"))
DO AUTO
+4 DO VAR
+5 SET PSUST=$PIECE(^XTMP("PSU_"_PSUJOB,"PSUSITE"),U,1)
+6 SET PSUSTNM=$PIECE(^XTMP("PSU_"_PSUJOB,"PSUSITE"),U,2)
+7 SET PSUMON=$PIECE(^XTMP("PSU_"_PSUJOB,"PSUMONTH"),U,1)
+8 ;
+9 SET XMDUZ=DUZ
+10 SET XMCHAN=1
+11 SET XMSUB="V. 4.0 PBMPRO"_" "_PSUMON_" "_PSUST_" "_PSUSTNM
+12 SET XMTEXT="^XTMP(""PSU_""_PSUJOB,""PSUSUM"","
+13 MERGE XMY=PSUXMYS1
+14 ;Summary only mailgroup
IF PSUSMRY=1
MERGE XMY=PSUXMYS2
+15 DO ^XMD
+16 QUIT
+17 ;
PDSUM ;EN Pt. demographics summary message
+1 ;
+2 ;don't send a mailman message if flag is set
if $DATA(^XTMP("PSU_"_PSUJOB,"PSUFLAG3"))
QUIT
+3 ;N PSUSTNM,PSUST
+4 DO PULL^PSUCP
+5 ;Find month if auto
IF '$DATA(^XTMP("PSU_"_PSUJOB,"PSUMONTH"))
DO AUTO
+6 DO VAR
+7 SET PSUST=$PIECE(^XTMP("PSU_"_PSUJOB,"PSUSITE"),U,1)
+8 SET PSUSTNM=$PIECE(^XTMP("PSU_"_PSUJOB,"PSUSITE"),U,2)
+9 SET PSUMON=$PIECE(^XTMP("PSU_"_PSUJOB,"PSUMONTH"),U,1)
+10 ;
+11 SET XMDUZ=DUZ
+12 SET XMCHAN=1
+13 SET XMSUB="V. 4.0 PBMPD"_" "_PSUMON_" "_PSUST_" "_PSUSTNM
+14 SET XMTEXT="^XTMP(""PSU_""_PSUJOB,""PSUSUMA"","
+15 ;Summary only mailgroup
IF PSUSMRY=1
MERGE XMY=PSUXMYS2
+16 ;No Data mailgroup
MERGE XMY=PSUXMYS1
+17 DO ^XMD
+18 QUIT