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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSUCP2 4258 printed Dec 13, 2024@02:27:30 Page 2
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
