212 lines
6.0 KiB
Mathematica
212 lines
6.0 KiB
Mathematica
PSUMAPR ;BHM/PDW-REPORT OF MAP OAU,NAOU,DA LOCATION TO DIVISION/OUTPATIENT SITES ; 9SEP2003
|
|
;;4.0;PHARMACY BENEFITS MANAGEMENT;**7,9**;MARCH, 2005;Build 6
|
|
;
|
|
;DBIA's
|
|
; Reference to file (#58.1) supported by DBIA 2515
|
|
; Reference to file (#58.8) supported by DBIA 2519
|
|
; Reference to file (#59.7) supported by DBIA 2854
|
|
;
|
|
EN ; select Editing or Report of Mapping
|
|
N C
|
|
K PG,LINE,LINE2
|
|
S PSQUIT=0,HDR="",$P(LINE,"=",79)="",$P(LINE2,"-",15)=""
|
|
D PGH
|
|
AOU S HDR="AR/WS AOU" D PGH1
|
|
S C=0
|
|
S PSNM="" F S PSNM=$O(^PSI(58.1,"B",PSNM)) Q:PSNM="" D Q:PSQUIT
|
|
. S PSDA=0 F S PSDA=$O(^PSI(58.1,"B",PSNM,PSDA)) Q:PSDA'>0 D Q:PSQUIT
|
|
.. D BRK Q:PSQUIT
|
|
.. S C=C+1
|
|
.. W !,PSNM
|
|
.. S IEN=PSDA_",1",PSDIV=$$GET1^DIQ(59.79001,IEN,.02),PSOP=$$GET1^DIQ(59.79001,IEN,.03) W:$L(PSDIV) ?30,"Div: ",PSDIV W:$L(PSOP) ?30,"Op: ",PSOP
|
|
.. S PSINADT=$$GET1^DIQ(58.1,PSDA,3,"I") I PSINADT W ?60,$$FMTE^XLFDT(PSINADT,"D")
|
|
W !
|
|
D PG Q:PSQUIT
|
|
;
|
|
NAOU ;CS NAOU Drug Accountability 'Primary
|
|
Q:PSQUIT
|
|
S HDR="CS NAOU" D PGH1
|
|
S C=0
|
|
S PSNM="" F S PSNM=$O(^PSD(58.8,"B",PSNM)) Q:PSNM="" D Q:PSQUIT
|
|
. S PSDA=0 F S PSDA=$O(^PSD(58.8,"B",PSNM,PSDA)) Q:PSDA'>0 D
|
|
.. S PSN0=^PSD(58.8,PSDA,0),PSTYP=$P(PSN0,U,2),PSINADT=+$G(^PSD(58.8,PSDA,"I"))
|
|
.. I PSTYP="P" Q
|
|
.. D BRK Q:PSQUIT
|
|
.. S C=C+1
|
|
.. W !,PSNM
|
|
.. S IEN=PSDA_",1",PSDIV=$$GET1^DIQ(59.79002,IEN,.02),PSOP=$$GET1^DIQ(59.79002,IEN,.03) W:$L(PSDIV) ?30,"Div: ",PSDIV W:$L(PSOP) ?30,"Op: ",PSOP
|
|
.. S PSINADT=$$GET1^DIQ(58.8,PSDA,4,"I")
|
|
.. I PSINADT W ?60,$$FMTE^XLFDT(PSINADT,"D")
|
|
W !
|
|
D PG Q:PSQUIT
|
|
;
|
|
DRACC ;
|
|
Q:PSQUIT
|
|
S HDR="DRUG ACCOUNTABILITY"
|
|
D PGH1
|
|
S C=0
|
|
S PSNM="" F S PSNM=$O(^PSD(58.8,"B",PSNM)) Q:PSNM="" D Q:PSQUIT
|
|
. S PSDA=0 F S PSDA=$O(^PSD(58.8,"B",PSNM,PSDA)) Q:'PSDA D
|
|
.. S PSN0=^PSD(58.8,PSDA,0),PSTYP=$P(PSN0,U,2)
|
|
.. S PSINADT=+$G(^PSD(58.8,PSDA,"I"))
|
|
.. I PSTYP'="P" Q
|
|
.. D BRK Q:PSQUIT
|
|
.. S C=C+1
|
|
.. W !,PSNM
|
|
.. S IEN=PSDA_",1",PSDIV=$$GET1^DIQ(59.79003,IEN,.02),PSOP=$$GET1^DIQ(59.79003,IEN,.03) W:$L(PSDIV) ?30,"Div: ",PSDIV W:$L(PSOP) ?30,"Op: ",PSOP
|
|
.. S PSINADT=$$GET1^DIQ(58.8,PSDA,4,"I")
|
|
.. I PSINADT W ?60,$$FMTE^XLFDT(PSINADT,"D")
|
|
;
|
|
I $E(IOST)="C" W !! K DIR S DIR(0)="EA",DIR("A")="Report Finished <cr>" D ^DIR
|
|
Q
|
|
EN1 ;Scan for unmapped locations
|
|
;Called from PSUOP0
|
|
;
|
|
N PSULOC,PSULOC1,PSULOC2
|
|
S PSQUIT=0
|
|
D AOU1 ;Look for AR/WS AOU's
|
|
D NAOU1 ;Look for CS NAOU's
|
|
D DRACC1 ;Look for Drug Accountability Pharmacy Locations
|
|
D UNMAPD
|
|
D MAPD
|
|
Q
|
|
;
|
|
AOU1 ;Find AR/WS AOU's and set unmapped locations into AOU array
|
|
;
|
|
S PSULOC=" AR/WS AOU's "
|
|
;
|
|
K AOU
|
|
S PSNM="" F S PSNM=$O(^PSI(58.1,"B",PSNM)) Q:PSNM="" D Q:PSQUIT
|
|
.S PSDA=0 F S PSDA=$O(^PSI(58.1,"B",PSNM,PSDA)) Q:PSDA'>0 D
|
|
..S IEN=PSDA_",1",PSDIV=$$GET1^DIQ(59.79001,IEN,.02)
|
|
..S PSOP=$$GET1^DIQ(59.79001,IEN,.03)
|
|
..I '$L(PSDIV),'$L(PSOP) S AOU(PSNM,PSDA)=$$GET1^DIQ(58.1,PSDA,3)
|
|
Q
|
|
;
|
|
NAOU1 ;Find Controlled Substances AOU's and set unmapped locations
|
|
;into NAOU array
|
|
;
|
|
S PSULOC1=" CS NAOUs "
|
|
;
|
|
K NAOU
|
|
S PSNM="" F S PSNM=$O(^PSD(58.8,"B",PSNM)) Q:PSNM="" D Q:PSQUIT
|
|
.S PSDA=0
|
|
.F S PSDA=$O(^PSD(58.8,"B",PSNM,PSDA)) Q:PSDA'>0 D
|
|
..S PSN0=^PSD(58.8,PSDA,0)
|
|
..S PSTYP=$P(PSN0,U,2)
|
|
..S PSINADT=+$G(^PSD(58.8,PSDA,"I"))
|
|
..I PSTYP="P" Q
|
|
..S IEN=PSDA_",1"
|
|
..S PSDIV=$$GET1^DIQ(59.79002,IEN,.02)
|
|
..S PSOP=$$GET1^DIQ(59.79002,IEN,.03)
|
|
..I '$L(PSDIV),'$L(PSOP) S NAOU(PSNM,PSDA)=$$GET1^DIQ(58.8,PSDA,4)
|
|
Q
|
|
;
|
|
DRACC1 ;Find DA Pharmacy Locations and set unmapped locations into DRAC array
|
|
;
|
|
S PSULOC2=" DA Pharmacy Locations "
|
|
;
|
|
K DRAC
|
|
S PSNM="" F S PSNM=$O(^PSD(58.8,"B",PSNM)) Q:PSNM="" D Q:PSQUIT
|
|
.S PSDA=0
|
|
.F S PSDA=$O(^PSD(58.8,"B",PSNM,PSDA)) Q:'PSDA D
|
|
..S PSN0=^PSD(58.8,PSDA,0),PSTYP=$P(PSN0,U,2)
|
|
..S PSINADT=+$G(^PSD(58.8,PSDA,"I"))
|
|
..I PSTYP'="P" Q
|
|
..S IEN=PSDA_",1"
|
|
..S PSDIV=$$GET1^DIQ(59.79003,IEN,.02)
|
|
..S PSOP=$$GET1^DIQ(59.79003,IEN,.03)
|
|
..I '$L(PSDIV),'$L(PSOP) S DRAC(PSNM,PSDA)=$$GET1^DIQ(58.8,PSDA,4)
|
|
Q
|
|
;
|
|
MAPD ;Display this if all locations are mapped
|
|
;
|
|
I '$D(AOU),'$D(NAOU),'$D(DRAC) D Q
|
|
. W !!,?3,"All pharmacy dispensing/procurement locations are mapped.",!
|
|
Q
|
|
;
|
|
UNMAPD ;Display this if unmapped locations exist
|
|
;
|
|
N C
|
|
W !
|
|
I $D(AOU) S PSNM="" D ;Unmapped AR/WS AOU's
|
|
.S C=0
|
|
.W !,?5,"The following"_PSULOC_"are not mapped:"
|
|
.W !
|
|
.F S PSNM=$O(AOU(PSNM)) Q:PSNM="" D Q:PSQUIT
|
|
..S PSDA=0
|
|
..F S PSDA=$O(AOU(PSNM,PSDA)) Q:PSDA'>0 D Q:PSQUIT
|
|
...W !,?10,PSNM
|
|
...I AOU(PSNM,PSDA)'="" W ?40,"**Inactive**"
|
|
...D BRK Q:PSQUIT
|
|
...I C=(IOSL-5) S C=0
|
|
...S C=C+1
|
|
W !
|
|
D PG Q:PSQUIT
|
|
;
|
|
I $D(NAOU) S PSNM="" D ;Unmapped CS NAOUs
|
|
.S C=0
|
|
.W !,?5,"The following"_PSULOC1_"are not mapped:"
|
|
.W !
|
|
.F S PSNM=$O(NAOU(PSNM)) Q:PSNM="" D Q:PSQUIT
|
|
..S PSDA=0
|
|
..F S PSDA=$O(NAOU(PSNM,PSDA)) Q:PSDA'>0 D Q:PSQUIT
|
|
...W !,?10,PSNM
|
|
...I NAOU(PSNM,PSDA)'="" W ?40,"**Inactive**"
|
|
...D BRK Q:PSQUIT
|
|
...I C=(IOSL-5) S C=0
|
|
...S C=C+1
|
|
W !
|
|
D PG Q:PSQUIT
|
|
;
|
|
I $D(DRAC) S PSNM="" D ;Unmapped DA Pharmacy Locations
|
|
.S C=0
|
|
.W !,?5,"The following"_PSULOC2_"are not mapped:"
|
|
.W !
|
|
.F S PSNM=$O(DRAC(PSNM)) Q:PSNM="" D Q:PSQUIT
|
|
..S PSDA=0
|
|
..F S PSDA=$O(DRAC(PSNM,PSDA)) Q:PSDA'>0 D Q:PSQUIT
|
|
...W !,?10,PSNM
|
|
...I DRAC(PSNM,PSDA)'="" W ?40,"**Inactive**"
|
|
...D BRK Q:PSQUIT
|
|
...I C=(IOSL-5) S C=0
|
|
...S C=C+1
|
|
W !
|
|
D PG Q:PSQUIT
|
|
Q
|
|
;
|
|
BRK ;Page break. Occurs in the middle of a list
|
|
;
|
|
I C=(IOSL-5) D
|
|
.W !
|
|
.K DIR I $E(IOST)="C" S DIR(0)="E" D ^DIR
|
|
.I $D(Y),Y=0 S PSQUIT=1 Q
|
|
.S PG=$G(PG)+1
|
|
.W @IOF
|
|
;Q:$E(IOST,1,2)'="C-"!($D(IO("S")))
|
|
;K DIR W !
|
|
;S DIR(0)="E" D ^DIR K DIR
|
|
;I 'Y S PSQUIT=1 Q
|
|
Q
|
|
;
|
|
PG ;Page break between headers
|
|
;
|
|
K DIR I $E(IOST)="C" S DIR(0)="E" D ^DIR I Y=0 S PSQUIT=1 Q
|
|
S PG=$G(PG)+1
|
|
W @IOF
|
|
Q
|
|
;
|
|
PGH W @IOF
|
|
W !,"MAPPED/UNMAPPED LOCATIONS"
|
|
W ?30,$$FMTE^XLFDT(DT)
|
|
S PG=$G(PG)+1 W ?60,"PAGE: ",PG,!,LINE,!,"NAME",?30,"DIVISION/OUTPATIENT SITE",?60,"INACTIVE DATE"
|
|
PGH1 I $L(HDR) W !!,$G(HDR),!,LINE2
|
|
Q
|
|
PGB I $Y<(IOSL-4) S PSQUIT=1 Q
|
|
PGHB W @IOF
|
|
W !,"UNMAPPED LOCATIONS"
|
|
W ?30,$$FMTE^XLFDT(DT)
|
|
S PG=$G(PG)+1 W ?60,"PAGE: ",PG,!,LINE,!,"NAME",?40,"INACTIVE DATE"
|
|
PGH1B I $L(HDR) W !!,$G(HDR),!,LINE2
|
|
Q
|