PSBIHS3 ;KF/VAOIT PSB DRUG/PHAM ORDERABLE ITEM/IV ADD/SOL
;;1.0;PSB BCMA CPS FOXK;**1018**;;Build 27
EN ;
W @IOF
W !,"Hello "_$P($$GET1^DIQ(200,DUZ,.01,"E"),",",2)_" this report looks at the Following Files for 'Correct Drug Pointers'"
W !,?10,"Drug File (50) --->Pharmacy Orderble Item (50.7)"
W !,?10," ^ ^ | |"
W !,?10," | | | |"
W !,?10," | | | |"
W !,?10," | -------IV Additives (52.6) |"
W !,?10," -------------------------------IV Solution (52.7)"
TAS ;TASK IT OR NOT
S %ZIS="Q"
W ! D ^%ZIS K %ZIS
I POP D Q
.W $C(7)
.K VISN,PSBEDATE,PSBBDATE,PSBDV
; output not queued...
N PSBTK
I '$D(IO("Q")) D
.D WAIT^DICD U IO S PSBTK=1 D NEW
.I IO'=IO(0) D ^%ZISC
; set up the Task...
I $D(IO("Q")) D
.N ZTDESC,ZTSAVE,ZTIO,ZTRTN
.S ZTRTN="NEW^PSBIHS3"
.S ZTDESC="PSB Drug File Pharm Orderable Item IV Add/Sol Report"
.S ZTIO=ION
.D ^%ZTLOAD
.D HOME^%ZIS
.W !,$S($G(ZTSK):"Task number "_ZTSK_" queued.",1:"ERROR -- NOT QUEUED!")
.K IO("Q"),ZTSK
Q
NEW N PSBIEN,PSBIV,PSBIVD,PSBOI,PSBCNT
K ^TMP($J,"DRUG")
S (PSBCNT,PSBIEN)=0 F S PSBIEN=$O(^PSDRUG(PSBIEN)) Q:'+PSBIEN D
.Q:$P($G(^PSDRUG(PSBIEN,"I")),U,1)'="" ;NO INACTIVE
.S PSBOI=$P($G(^PSDRUG(PSBIEN,2)),U,1)
.Q:PSBOI'>0
.S PSBIV=0 F S PSBIV=$O(^PS(52.7,"AOI",PSBOI,PSBIV)) Q:PSBIV'>0 D
..S PSBIVD=$P($G(^PS(52.7,+PSBIV,0)),U,2)
..S PSBSTATUS=$S($P($G(^PS(52.7,+PSBIV,"I")),U,1)'="":"I",1:"A")
..Q:PSBIEN=+PSBIVD
..S PSBCNT=1
..I PSBIVD'>0 S PSBIVD="NOT SET"
..I PSBIV>0 S ^TMP($J,"DRUG","S",PSBSTATUS,PSBIV)=PSBOI_"^"_PSBIEN_"^"_PSBIVD
.;Additives
.S PSBIV=0 F S PSBIV=$O(^PS(52.6,"AOI",PSBOI,PSBIV)) Q:PSBIV'>0 D
..;S PSBIV=$O(^PS(52.6,"AOI",PSBOI,""))
..S PSBIVD=$P($G(^PS(52.6,+PSBIV,0)),U,2)
..S PSBSTATUS=$S($P($G(^PS(52.7,+PSBIV,"I")),U,1)'="":"I",1:"A")
..Q:PSBIEN=+PSBIVD
..S PBSCNT=1
..I PSBIVD'>0 S PSBIVD="NOT SET"
..I PSBIV>0 S ^TMP($J,"DRUG","A",PSBSTATUS,PSBIV)=PSBOI_"^"_PSBIEN_"^"_PSBIVD
;PRINT SOLUTIONS
N PSB1,PSB2,PSB3,PSB4
S PSB1="" F S PSB1=$O(^TMP($J,"DRUG","S",PSB1)) Q:PSB1="" D
.S PSB2="" F S PSB2=$O(^TMP($J,"DRUG","S",PSB1,PSB2)) Q:PSB2'>0 D
..S PSB3=$P(^TMP($J,"DRUG","S",PSB1,PSB2),"^",1),PSB4=$P(^TMP($J,"DRUG","S",PSB1,PSB2),"^",2)
..S PSB5=$P(^TMP($J,"DRUG","S",PSB1,PSB2),"^",3)
..I $Y>(IOSL-4) D HEAD
..W !,"Drug File: ",PSB4,U,$P($G(^PSDRUG(PSB4,0)),U,1)
..W !?5,"Pharmacy Orderable Item:",PSB3," ",$P($G(^PS(50.7,PSB3,0)),U,1)
..W !?5,"IV Solution IEN:",PSB2," Generic Drug:",PSB5," ",$P($G(^PSDRUG(PSB5,0)),U,1)
..W !?5,"IV Solution:",$S(PSB1="I":"INACTIVE",PSB1="A":"ACTIVE"),!!
N PSB1,PSB2,PSB3,PSB4
S PSB1="" F S PSB1=$O(^TMP($J,"DRUG","A",PSB1)) Q:PSB1="" D
.S PSB2="" F S PSB2=$O(^TMP($J,"DRUG","A",PSB1,PSB2)) Q:PSB2'>0 D
..S PSB3=$P(^TMP($J,"DRUG","A",PSB1,PSB2),"^",1),PSB4=$P(^TMP($J,"DRUG","A",PSB1,PSB2),"^",2)
..S PSB5=$P(^TMP($J,"DRUG","A",PSB1,PSB2),"^",3)
..I $Y>(IOSL-4) D HEAD
..W !,"Drug File: ",PSB4,U,$P($G(^PSDRUG(PSB4,0)),U,1)
..W !?5,"Pharmacy Orderable Item:",PSB3," ",$P($G(^PS(50.7,PSB3,0)),U,1)
..W !?5,"IV Additives IEN:",PSB2," Generic Drug:",PSB5," ",$P($G(^PSDRUG(PSB5,0)),U,1)
..W !?5,"IV Additives:",$S(PSB1="I":"INACTIVE",PSB1="A":"ACTIVE"),!!
I PSBCNT=0 W !,"Nothing to Report"
Q
HEAD ;
W @IOF
W !,"Drug File Pharmacy Orderable IV Additives/Solution Checker" D NOW^%DTC S Y=% D DD^%DT W ?60,$E(Y,1,18),!
F J=1:1:IOM W "-"
Q
REINACT ;RENAME ALL INACTIVE DRUGS TO ZZ/zz THEM
N PSBIEN,PSBIV,PSBIVD,PSBOI,PSBCNT
K ^TMP("$J")
S %DT("A")="Lets ZZ all inactive Drugs with 'INACTIVE DATE' before: "
S %DT="AE"
D ^%DT I X="^"!(X="")!(Y'>0) Q
S PSBBDATE=Y K %DT,Y
W @IOF,!,"Searching..." D WAIT^DICD
S (PSBCNT,PSBIEN)=0 F S PSBIEN=$O(^PSDRUG(PSBIEN)) Q:'+PSBIEN D
.S PSBDATE=$P($G(^PSDRUG(PSBIEN,"I")),U,1)
.Q:+PSBDATE>PSBBDATE ;BAIL ON THOSE WITH INACTIVE GREATER THAN DT ENTERS
.S PSBNAME=$P($G(^PSDRUG(PSBIEN,0)),U,1)
.Q:$E(PSBNAME,1,2)="ZZ" ;QUIET ALREADY ZZ'D"
.Q:$E(PSBNAME,1,2)="zz" ;QUIET ALREADY ZZ'D"
.S ^TMP($J,50,PSBIEN_",",.01)="ZZ"_PSBNAME
.W !,"IEN:"_PSBIEN_" RENAMING "_PSBNAME_" TO ZZ"_PSBNAME
.S PSBCNT=PSBCNT+1
I PSBCNT=0 W !!,"NONE FOUND" Q
W !,"Would like me to ZZ the "_PSBCNT_" INACTIVE Drugs?" S %=2 D YN^DICN
Q:%'=1
D WAIT^DICD
D UPDATE^DIE(,"^TMP($J)")
W !,"BYE I AM DONE NOW!"
PSBIHS3 ;KF/VAOIT PSB DRUG/PHAM ORDERABLE ITEM/IV ADD/SOL
+1 ;;1.0;PSB BCMA CPS FOXK;**1018**;;Build 27
EN ;
+1 WRITE @IOF
+2 WRITE !,"Hello "_$PIECE($$GET1^DIQ(200,DUZ,.01,"E"),",",2)_" this report looks at the Following Files for 'Correct Drug Pointers'"
+3 WRITE !,?10,"Drug File (50) --->Pharmacy Orderble Item (50.7)"
+4 WRITE !,?10," ^ ^ | |"
+5 WRITE !,?10," | | | |"
+6 WRITE !,?10," | | | |"
+7 WRITE !,?10," | -------IV Additives (52.6) |"
+8 WRITE !,?10," -------------------------------IV Solution (52.7)"
TAS ;TASK IT OR NOT
+1 SET %ZIS="Q"
+2 WRITE !
DO ^%ZIS
KILL %ZIS
+3 IF POP
Begin DoDot:1
+4 WRITE $CHAR(7)
+5 KILL VISN,PSBEDATE,PSBBDATE,PSBDV
End DoDot:1
QUIT
+6 ; output not queued...
+7 NEW PSBTK
+8 IF '$DATA(IO("Q"))
Begin DoDot:1
+9 DO WAIT^DICD
USE IO
SET PSBTK=1
DO NEW
+10 IF IO'=IO(0)
DO ^%ZISC
End DoDot:1
+11 ; set up the Task...
+12 IF $DATA(IO("Q"))
Begin DoDot:1
+13 NEW ZTDESC,ZTSAVE,ZTIO,ZTRTN
+14 SET ZTRTN="NEW^PSBIHS3"
+15 SET ZTDESC="PSB Drug File Pharm Orderable Item IV Add/Sol Report"
+16 SET ZTIO=ION
+17 DO ^%ZTLOAD
+18 DO HOME^%ZIS
+19 WRITE !,$SELECT($GET(ZTSK):"Task number "_ZTSK_" queued.",1:"ERROR -- NOT QUEUED!")
+20 KILL IO("Q"),ZTSK
End DoDot:1
+21 QUIT
NEW NEW PSBIEN,PSBIV,PSBIVD,PSBOI,PSBCNT
+1 KILL ^TMP($JOB,"DRUG")
+2 SET (PSBCNT,PSBIEN)=0
FOR
SET PSBIEN=$ORDER(^PSDRUG(PSBIEN))
IF '+PSBIEN
QUIT
Begin DoDot:1
+3 ;NO INACTIVE
IF $PIECE($GET(^PSDRUG(PSBIEN,"I")),U,1)'=""
QUIT
+4 SET PSBOI=$PIECE($GET(^PSDRUG(PSBIEN,2)),U,1)
+5 IF PSBOI'>0
QUIT
+6 SET PSBIV=0
FOR
SET PSBIV=$ORDER(^PS(52.7,"AOI",PSBOI,PSBIV))
IF PSBIV'>0
QUIT
Begin DoDot:2
+7 SET PSBIVD=$PIECE($GET(^PS(52.7,+PSBIV,0)),U,2)
+8 SET PSBSTATUS=$SELECT($PIECE($GET(^PS(52.7,+PSBIV,"I")),U,1)'="":"I",1:"A")
+9 IF PSBIEN=+PSBIVD
QUIT
+10 SET PSBCNT=1
+11 IF PSBIVD'>0
SET PSBIVD="NOT SET"
+12 IF PSBIV>0
SET ^TMP($JOB,"DRUG","S",PSBSTATUS,PSBIV)=PSBOI_"^"_PSBIEN_"^"_PSBIVD
End DoDot:2
+13 ;Additives
+14 SET PSBIV=0
FOR
SET PSBIV=$ORDER(^PS(52.6,"AOI",PSBOI,PSBIV))
IF PSBIV'>0
QUIT
Begin DoDot:2
+15 ;S PSBIV=$O(^PS(52.6,"AOI",PSBOI,""))
+16 SET PSBIVD=$PIECE($GET(^PS(52.6,+PSBIV,0)),U,2)
+17 SET PSBSTATUS=$SELECT($PIECE($GET(^PS(52.7,+PSBIV,"I")),U,1)'="":"I",1:"A")
+18 IF PSBIEN=+PSBIVD
QUIT
+19 SET PBSCNT=1
+20 IF PSBIVD'>0
SET PSBIVD="NOT SET"
+21 IF PSBIV>0
SET ^TMP($JOB,"DRUG","A",PSBSTATUS,PSBIV)=PSBOI_"^"_PSBIEN_"^"_PSBIVD
End DoDot:2
End DoDot:1
+22 ;PRINT SOLUTIONS
+23 NEW PSB1,PSB2,PSB3,PSB4
+24 SET PSB1=""
FOR
SET PSB1=$ORDER(^TMP($JOB,"DRUG","S",PSB1))
IF PSB1=""
QUIT
Begin DoDot:1
+25 SET PSB2=""
FOR
SET PSB2=$ORDER(^TMP($JOB,"DRUG","S",PSB1,PSB2))
IF PSB2'>0
QUIT
Begin DoDot:2
+26 SET PSB3=$PIECE(^TMP($JOB,"DRUG","S",PSB1,PSB2),"^",1)
SET PSB4=$PIECE(^TMP($JOB,"DRUG","S",PSB1,PSB2),"^",2)
+27 SET PSB5=$PIECE(^TMP($JOB,"DRUG","S",PSB1,PSB2),"^",3)
+28 IF $Y>(IOSL-4)
DO HEAD
+29 WRITE !,"Drug File: ",PSB4,U,$PIECE($GET(^PSDRUG(PSB4,0)),U,1)
+30 WRITE !?5,"Pharmacy Orderable Item:",PSB3," ",$PIECE($GET(^PS(50.7,PSB3,0)),U,1)
+31 WRITE !?5,"IV Solution IEN:",PSB2," Generic Drug:",PSB5," ",$PIECE($GET(^PSDRUG(PSB5,0)),U,1)
+32 WRITE !?5,"IV Solution:",$SELECT(PSB1="I":"INACTIVE",PSB1="A":"ACTIVE"),!!
End DoDot:2
End DoDot:1
+33 NEW PSB1,PSB2,PSB3,PSB4
+34 SET PSB1=""
FOR
SET PSB1=$ORDER(^TMP($JOB,"DRUG","A",PSB1))
IF PSB1=""
QUIT
Begin DoDot:1
+35 SET PSB2=""
FOR
SET PSB2=$ORDER(^TMP($JOB,"DRUG","A",PSB1,PSB2))
IF PSB2'>0
QUIT
Begin DoDot:2
+36 SET PSB3=$PIECE(^TMP($JOB,"DRUG","A",PSB1,PSB2),"^",1)
SET PSB4=$PIECE(^TMP($JOB,"DRUG","A",PSB1,PSB2),"^",2)
+37 SET PSB5=$PIECE(^TMP($JOB,"DRUG","A",PSB1,PSB2),"^",3)
+38 IF $Y>(IOSL-4)
DO HEAD
+39 WRITE !,"Drug File: ",PSB4,U,$PIECE($GET(^PSDRUG(PSB4,0)),U,1)
+40 WRITE !?5,"Pharmacy Orderable Item:",PSB3," ",$PIECE($GET(^PS(50.7,PSB3,0)),U,1)
+41 WRITE !?5,"IV Additives IEN:",PSB2," Generic Drug:",PSB5," ",$PIECE($GET(^PSDRUG(PSB5,0)),U,1)
+42 WRITE !?5,"IV Additives:",$SELECT(PSB1="I":"INACTIVE",PSB1="A":"ACTIVE"),!!
End DoDot:2
End DoDot:1
+43 IF PSBCNT=0
WRITE !,"Nothing to Report"
+44 QUIT
HEAD ;
+1 WRITE @IOF
+2 WRITE !,"Drug File Pharmacy Orderable IV Additives/Solution Checker"
DO NOW^%DTC
SET Y=%
DO DD^%DT
WRITE ?60,$EXTRACT(Y,1,18),!
+3 FOR J=1:1:IOM
WRITE "-"
+4 QUIT
REINACT ;RENAME ALL INACTIVE DRUGS TO ZZ/zz THEM
+1 NEW PSBIEN,PSBIV,PSBIVD,PSBOI,PSBCNT
+2 KILL ^TMP("$J")
+3 SET %DT("A")="Lets ZZ all inactive Drugs with 'INACTIVE DATE' before: "
+4 SET %DT="AE"
+5 DO ^%DT
IF X="^"!(X="")!(Y'>0)
QUIT
+6 SET PSBBDATE=Y
KILL %DT,Y
+7 WRITE @IOF,!,"Searching..."
DO WAIT^DICD
+8 SET (PSBCNT,PSBIEN)=0
FOR
SET PSBIEN=$ORDER(^PSDRUG(PSBIEN))
IF '+PSBIEN
QUIT
Begin DoDot:1
+9 SET PSBDATE=$PIECE($GET(^PSDRUG(PSBIEN,"I")),U,1)
+10 ;BAIL ON THOSE WITH INACTIVE GREATER THAN DT ENTERS
IF +PSBDATE>PSBBDATE
QUIT
+11 SET PSBNAME=$PIECE($GET(^PSDRUG(PSBIEN,0)),U,1)
+12 ;QUIET ALREADY ZZ'D"
IF $EXTRACT(PSBNAME,1,2)="ZZ"
QUIT
+13 ;QUIET ALREADY ZZ'D"
IF $EXTRACT(PSBNAME,1,2)="zz"
QUIT
+14 SET ^TMP($JOB,50,PSBIEN_",",.01)="ZZ"_PSBNAME
+15 WRITE !,"IEN:"_PSBIEN_" RENAMING "_PSBNAME_" TO ZZ"_PSBNAME
+16 SET PSBCNT=PSBCNT+1
End DoDot:1
+17 IF PSBCNT=0
WRITE !!,"NONE FOUND"
QUIT
+18 WRITE !,"Would like me to ZZ the "_PSBCNT_" INACTIVE Drugs?"
SET %=2
DO YN^DICN
+19 IF %'=1
QUIT
+20 DO WAIT^DICD
+21 DO UPDATE^DIE(,"^TMP($J)")
+22 WRITE !,"BYE I AM DONE NOW!"
