- 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!"
