- PSUCP2 ;BIR/TJH - CHECK COMPLETION OF MONTHLY PBM REPORT ;25 AUG 1998
- ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
- ;
- ;DBIAs
- ; Reference to File #4 supported by DBIA 10090
- ; Reference to File #4.3 supported by DBIA 10091
- ; Reference to File #40.8 supported by DBIA 2438
- ; Reference to File #59.7 supported by DBIA 2854
- ;
- MANUAL ; Entry point if tasked by PSU PBM MANUAL option
- S PSUWAY="Manual"
- AUTO ; Entry point if tasked by PSU PBM AUTO option
- I '$D(PSUWAY) S PSUWAY="Automatic"
- D NOW^%DTC
- S PSUNOW=% K %,%H,%I,X
- S PSULRD=$$VALI^PSUTL(59.7,1,90) ; last run date
- D
- .I PSULRD="" S PSUOK=0 Q ; it's 24 hours later and finish time is not set, may be a problem.
- .S X1=PSUNOW,X2=PSULRD D ^%DTC
- .I X>6 S PSUOK=0 Q ; the last run date must be left over from a previous run, it's a problem.
- .S PSUOK=1
- G:PSUOK EXIT ; no message sent if OK.
- D XMY^PSUTL1
- M XMY=PSUXMYS1
- I $G(PSUMASF) M XMY=PSUXMYH
- S X=$$VALI^PSUTL(4.3,1,217),PSUDIV=+$$VAL^PSUTL(4,X,99)
- S X=PSUDIV,DIC=40.8,DIC(0)="XM" D ^DIC
- S X=+Y S PSUDIVNM=$$VAL^PSUTL(40.8,X,.01)
- S XMSUB="PBM "_PSUWAY_" Statistics Job "_PSUDIV_" "_PSUDIVNM
- S X(1)="The PBM "_PSUWAY_" Statistics background job did not run to completion."
- S X(2)="Please correct the problem and retransmit the data to the National PBM"
- S X(3)="section at Hines."
- S XMTEXT="X("
- S XMCHAN=1
- D ^XMD
- EXIT ; normal exit point from PSUCP2
- K PSUWAY,PSUNOW,PSULRD,PSUOK,PSUDIV,PSUDIVNM
- Q
- MMNOMAP ; Generate MM regarding locations not mapped
- Q:$D(^XTMP("PSU_"_PSUJOB,"PSUFLAG3")) ;Quit if user does not want a
- ;copy sent to self
- ;
- N TXT1,TXT2
- ;
- D PULL^PSUCP
- F I=1:1:$L(PSUOPTS,",") S PSUMOD($P(PSUOPTS,",",I))=""
- S X=$$VALI^PSUTL(4.3,1,217),PSUSNDR=+$$VAL^PSUTL(4,X,99),PSUNAME=$$VAL^PSUTL(4,X,.01)
- K TXT
- S TXT(1)="The locations listed below have not been mapped to a Medical Center"
- S TXT(2)="Division or Outpatient Site. All data extracted from these locations have"
- S TXT(3)="been attributed to "_PSUSNDR_" "_PSUNAME
- S TXT(4)=" "
- S TLC=4
- ;
- I $D(PSUARSUB) D
- .I $D(^XTMP(PSUARSUB,"AOU")),$D(PSUMOD(3)) D
- ..K AOUNMAP,MAP ;Array to hold unmapped AOU data
- ..N LOC,LOC1
- ..M MAP=^XTMP(PSUARSUB,"AOU")
- ..F TXT=" ","AOUs:" D TXT
- ..S IEN=0 F S IEN=$O(MAP(IEN)) Q:IEN="" D
- ...S LOC=MAP(IEN,.01)
- ...M AOUNMAP(LOC)=MAP(IEN)
- ..S LOC1=0
- ..F S LOC1=$O(AOUNMAP(LOC1)) Q:LOC1="" D
- ...S TXT1=AOUNMAP(LOC1,.01)
- ...S TXT2=$G(AOUNMAP(LOC1,3)) I TXT2'="" S TXT2=" **INACTIVE**"
- ...S TXT=TXT1_TXT2 D TXT
- .;
- .I '$D(^XTMP(PSUARSUB,"AOU")),$D(PSUMOD(3)) D
- ..F TXT=" ","AOUs:" D TXT
- ..S TXT="There are no unmapped AOU's for the dates of this extract" D TXT
- ;
- I $D(PSUARSUB) D
- .I $D(^XTMP(PSUARSUB,"NAOU")),$D(PSUMOD(6)) D
- ..K NAOUMAP,MAP
- ..N LOC,LOC1
- ..M MAP=^XTMP(PSUARSUB,"NAOU")
- ..F TXT="","NAOUs:" D TXT
- ..S IEN=0 F S IEN=$O(MAP(IEN)) Q:IEN'>0 D
- ...S LOC=MAP(IEN,.01)
- ...M NAOUMAP(LOC)=MAP(IEN)
- ..S LOC1=0
- ..F S LOC1=$O(NAOUMAP(LOC1)) Q:LOC1="" D
- ...S TXT1=NAOUMAP(LOC1,.01)
- ...S TXT2=$G(NAOUMAP(LOC1,4)) I TXT2'="" S TXT2=" **INACTIVE**"
- ...S TXT=TXT1_TXT2 D TXT
- .;
- .I '$D(^XTMP(PSUARSUB,"NAOU")),$D(PSUMOD(6)) D
- .. F TXT=" ","NAOUs:" D TXT
- ..S TXT="There are no unmapped NAOU's for the dates of this extract" D TXT
- ;
- I $D(PSUARSUB) D
- .I $D(^XTMP(PSUARSUB,"DAPH")),$D(PSUMOD(5)) D
- ..K DAPH,MAP
- ..N LOC,LOC1
- ..M MAP=^XTMP(PSUARSUB,"DAPH")
- ..F TXT="","DA Pharmacy Locations:" D TXT
- ..S IEN=0 F S IEN=$O(MAP(IEN)) Q:IEN'>0 D
- ...S LOC=MAP(IEN,.01)
- ...M DAPH(LOC)=MAP(IEN)
- ..S LOC1=0
- ..F S LOC1=$O(DAPH(LOC1)) Q:LOC1="" D
- ...S TXT1=DAPH(LOC1,.01)
- ...S TXT2=$G(DAPH(LOC1,4)) I TXT2'="" S TXT2=" **INACTIVE**"
- ...S TXT=TXT1_TXT2 D TXT
- .;
- .I '$D(^XTMP(PSUARSUB,"DAPH")),$D(PSUMOD(5)) D
- .. F TXT=" ","DA Pharmacy Locations:" D TXT
- ..S TXT="There are no unmapped DA Pharmacy Locations for the dates of this extract" D TXT
- ;
- MSGNOMAP ; send MM
- ;
- S Y=PSUSDT\1 X ^DD("DD") S PSUDTS=Y
- S Y=PSUEDT\1 X ^DD("DD") S PSUDTE=Y
- S XMSUB="PBM Unmapped Locations for "_PSUDTS_" to "_PSUDTE_" from "_PSUSNDR_" "_PSUNAME
- S XMTEXT="TXT("
- S XMY("G.PSU PBM")=""
- S XMY(DUZ)=""
- I $D(PSUARSUB) D ^XMD
- Q
- ;
- TXT S TLC=TLC+1,TXT(TLC)=TXT
- Q
- PSUCP2 ;BIR/TJH - CHECK COMPLETION OF MONTHLY PBM REPORT ;25 AUG 1998
- +1 ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
- +2 ;
- +3 ;DBIAs
- +4 ; Reference to File #4 supported by DBIA 10090
- +5 ; Reference to File #4.3 supported by DBIA 10091
- +6 ; Reference to File #40.8 supported by DBIA 2438
- +7 ; Reference to File #59.7 supported by DBIA 2854
- +8 ;
- MANUAL ; Entry point if tasked by PSU PBM MANUAL option
- +1 SET PSUWAY="Manual"
- AUTO ; Entry point if tasked by PSU PBM AUTO option
- +1 IF '$DATA(PSUWAY)
- SET PSUWAY="Automatic"
- +2 DO NOW^%DTC
- +3 SET PSUNOW=%
- KILL %,%H,%I,X
- +4 ; last run date
- SET PSULRD=$$VALI^PSUTL(59.7,1,90)
- +5 Begin DoDot:1
- +6 ; it's 24 hours later and finish time is not set, may be a problem.
- IF PSULRD=""
- SET PSUOK=0
- QUIT
- +7 SET X1=PSUNOW
- SET X2=PSULRD
- DO ^%DTC
- +8 ; the last run date must be left over from a previous run, it's a problem.
- IF X>6
- SET PSUOK=0
- QUIT
- +9 SET PSUOK=1
- End DoDot:1
- +10 ; no message sent if OK.
- IF PSUOK
- GOTO EXIT
- +11 DO XMY^PSUTL1
- +12 MERGE XMY=PSUXMYS1
- +13 IF $GET(PSUMASF)
- MERGE XMY=PSUXMYH
- +14 SET X=$$VALI^PSUTL(4.3,1,217)
- SET PSUDIV=+$$VAL^PSUTL(4,X,99)
- +15 SET X=PSUDIV
- SET DIC=40.8
- SET DIC(0)="XM"
- DO ^DIC
- +16 SET X=+Y
- SET PSUDIVNM=$$VAL^PSUTL(40.8,X,.01)
- +17 SET XMSUB="PBM "_PSUWAY_" Statistics Job "_PSUDIV_" "_PSUDIVNM
- +18 SET X(1)="The PBM "_PSUWAY_" Statistics background job did not run to completion."
- +19 SET X(2)="Please correct the problem and retransmit the data to the National PBM"
- +20 SET X(3)="section at Hines."
- +21 SET XMTEXT="X("
- +22 SET XMCHAN=1
- +23 DO ^XMD
- EXIT ; normal exit point from PSUCP2
- +1 KILL PSUWAY,PSUNOW,PSULRD,PSUOK,PSUDIV,PSUDIVNM
- +2 QUIT
- MMNOMAP ; Generate MM regarding locations not mapped
- +1 ;Quit if user does not want a
- IF $DATA(^XTMP("PSU_"_PSUJOB,"PSUFLAG3"))
- QUIT
- +2 ;copy sent to self
- +3 ;
- +4 NEW TXT1,TXT2
- +5 ;
- +6 DO PULL^PSUCP
- +7 FOR I=1:1:$LENGTH(PSUOPTS,",")
- SET PSUMOD($PIECE(PSUOPTS,",",I))=""
- +8 SET X=$$VALI^PSUTL(4.3,1,217)
- SET PSUSNDR=+$$VAL^PSUTL(4,X,99)
- SET PSUNAME=$$VAL^PSUTL(4,X,.01)
- +9 KILL TXT
- +10 SET TXT(1)="The locations listed below have not been mapped to a Medical Center"
- +11 SET TXT(2)="Division or Outpatient Site. All data extracted from these locations have"
- +12 SET TXT(3)="been attributed to "_PSUSNDR_" "_PSUNAME
- +13 SET TXT(4)=" "
- +14 SET TLC=4
- +15 ;
- +16 IF $DATA(PSUARSUB)
- Begin DoDot:1
- +17 IF $DATA(^XTMP(PSUARSUB,"AOU"))
- IF $DATA(PSUMOD(3))
- Begin DoDot:2
- +18 ;Array to hold unmapped AOU data
- KILL AOUNMAP,MAP
- +19 NEW LOC,LOC1
- +20 MERGE MAP=^XTMP(PSUARSUB,"AOU")
- +21 FOR TXT=" ","AOUs:"
- DO TXT
- +22 SET IEN=0
- FOR
- SET IEN=$ORDER(MAP(IEN))
- IF IEN=""
- QUIT
- Begin DoDot:3
- +23 SET LOC=MAP(IEN,.01)
- +24 MERGE AOUNMAP(LOC)=MAP(IEN)
- End DoDot:3
- +25 SET LOC1=0
- +26 FOR
- SET LOC1=$ORDER(AOUNMAP(LOC1))
- IF LOC1=""
- QUIT
- Begin DoDot:3
- +27 SET TXT1=AOUNMAP(LOC1,.01)
- +28 SET TXT2=$GET(AOUNMAP(LOC1,3))
- IF TXT2'=""
- SET TXT2=" **INACTIVE**"
- +29 SET TXT=TXT1_TXT2
- DO TXT
- End DoDot:3
- End DoDot:2
- +30 ;
- +31 IF '$DATA(^XTMP(PSUARSUB,"AOU"))
- IF $DATA(PSUMOD(3))
- Begin DoDot:2
- +32 FOR TXT=" ","AOUs:"
- DO TXT
- +33 SET TXT="There are no unmapped AOU's for the dates of this extract"
- DO TXT
- End DoDot:2
- End DoDot:1
- +34 ;
- +35 IF $DATA(PSUARSUB)
- Begin DoDot:1
- +36 IF $DATA(^XTMP(PSUARSUB,"NAOU"))
- IF $DATA(PSUMOD(6))
- Begin DoDot:2
- +37 KILL NAOUMAP,MAP
- +38 NEW LOC,LOC1
- +39 MERGE MAP=^XTMP(PSUARSUB,"NAOU")
- +40 FOR TXT="","NAOUs:"
- DO TXT
- +41 SET IEN=0
- FOR
- SET IEN=$ORDER(MAP(IEN))
- IF IEN'>0
- QUIT
- Begin DoDot:3
- +42 SET LOC=MAP(IEN,.01)
- +43 MERGE NAOUMAP(LOC)=MAP(IEN)
- End DoDot:3
- +44 SET LOC1=0
- +45 FOR
- SET LOC1=$ORDER(NAOUMAP(LOC1))
- IF LOC1=""
- QUIT
- Begin DoDot:3
- +46 SET TXT1=NAOUMAP(LOC1,.01)
- +47 SET TXT2=$GET(NAOUMAP(LOC1,4))
- IF TXT2'=""
- SET TXT2=" **INACTIVE**"
- +48 SET TXT=TXT1_TXT2
- DO TXT
- End DoDot:3
- End DoDot:2
- +49 ;
- +50 IF '$DATA(^XTMP(PSUARSUB,"NAOU"))
- IF $DATA(PSUMOD(6))
- Begin DoDot:2
- +51 FOR TXT=" ","NAOUs:"
- DO TXT
- +52 SET TXT="There are no unmapped NAOU's for the dates of this extract"
- DO TXT
- End DoDot:2
- End DoDot:1
- +53 ;
- +54 IF $DATA(PSUARSUB)
- Begin DoDot:1
- +55 IF $DATA(^XTMP(PSUARSUB,"DAPH"))
- IF $DATA(PSUMOD(5))
- Begin DoDot:2
- +56 KILL DAPH,MAP
- +57 NEW LOC,LOC1
- +58 MERGE MAP=^XTMP(PSUARSUB,"DAPH")
- +59 FOR TXT="","DA Pharmacy Locations:"
- DO TXT
- +60 SET IEN=0
- FOR
- SET IEN=$ORDER(MAP(IEN))
- IF IEN'>0
- QUIT
- Begin DoDot:3
- +61 SET LOC=MAP(IEN,.01)
- +62 MERGE DAPH(LOC)=MAP(IEN)
- End DoDot:3
- +63 SET LOC1=0
- +64 FOR
- SET LOC1=$ORDER(DAPH(LOC1))
- IF LOC1=""
- QUIT
- Begin DoDot:3
- +65 SET TXT1=DAPH(LOC1,.01)
- +66 SET TXT2=$GET(DAPH(LOC1,4))
- IF TXT2'=""
- SET TXT2=" **INACTIVE**"
- +67 SET TXT=TXT1_TXT2
- DO TXT
- End DoDot:3
- End DoDot:2
- +68 ;
- +69 IF '$DATA(^XTMP(PSUARSUB,"DAPH"))
- IF $DATA(PSUMOD(5))
- Begin DoDot:2
- +70 FOR TXT=" ","DA Pharmacy Locations:"
- DO TXT
- +71 SET TXT="There are no unmapped DA Pharmacy Locations for the dates of this extract"
- DO TXT
- End DoDot:2
- End DoDot:1
- +72 ;
- MSGNOMAP ; send MM
- +1 ;
- +2 SET Y=PSUSDT\1
- XECUTE ^DD("DD")
- SET PSUDTS=Y
- +3 SET Y=PSUEDT\1
- XECUTE ^DD("DD")
- SET PSUDTE=Y
- +4 SET XMSUB="PBM Unmapped Locations for "_PSUDTS_" to "_PSUDTE_" from "_PSUSNDR_" "_PSUNAME
- +5 SET XMTEXT="TXT("
- +6 SET XMY("G.PSU PBM")=""
- +7 SET XMY(DUZ)=""
- +8 IF $DATA(PSUARSUB)
- DO ^XMD
- +9 QUIT
- +10 ;
- TXT SET TLC=TLC+1
- SET TXT(TLC)=TXT
- +1 QUIT
