- 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 Feb 18, 2025@23:53:49 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