PSIVRQ1 ;BIR/PR-CONT. REPORT DRIVER ;16 DEC 97 / 1:40 PM
;;5.0; INPATIENT MEDICATIONS ;**31**;16 DEC 97
;
; Reference to ^PS(50.605 is supported by DBIA #2138
;
D:$D(PSIVDCR) D D:$D(PSIVPCR) P D:$D(PSIVPAT) PAT I $D(PSIVWCR) D D Q:"^"[X D I3
G:"^"[X!(X<0) K^PSIVRQ
QUEUE ;Queue logic
W ! K IO("Q"),%ZIS,IOP S %ZIS("B")=PSIVPR,%ZIS="QM" D ^%ZIS I POP W !,"NO DEVICE SELECTED OR REPORT PRINTED" G K^PSIVRQ
G:'$D(IO("Q")) NQ S ZTRTN=$S($D(PSIVPCR):"^PSIVPCR",$D(PSIVDCR):"^PSIVDCR",$D(PSIVWCR):"^PSIVWCR",$D(PSIVPAT):"^PSIVPAT",1:"^PSIVAMIS")
K ZTDTH,ZTSAVE,ZTSK S ZTIO="",I6=$S($G(IO("DOC"))'="":ION_";"_IO("DOC"),1:ION),ZTDESC="IV "_$S($D(PSIVPCR):"PROVIDER DRUG COST",$D(PSIVDCR):"DRUG COST",$D(PSIVWCR):"WARD/DRUG COST",$D(PSIVPAT):"PATIENT COST",1:"AMIS")_" REPORT (SORT)"
F G="PQ","I2","BRIEF","SMO","I3","I1","I5","I7","I8","I6","I9","I10","I11","I15","I4","UCO","LCO","PSIVPR","PSJSYSU","PSJSYSP0" S ZTSAVE(G)=""
K IO("Q") D ^%ZTLOAD W:$D(ZTSK) !,"Queued." D ^%ZISC G K^PSIVRQ
;
NQ ;No queue so run report
D @($S($D(PSIVPCR):"^PSIVPCR",$D(PSIVDCR):"^PSIVDCR",$D(PSIVPAT):"^PSIVPAT",$D(PSIVWCR):"^PSIVWCR",1:"^PSIVAMIS"))
G K^PSIVRQ
;
P ;Select provider for provider report
R !!,"Select PROVIDER (or enter ^ALL): ",X:DTIME W:'$T $C(7) Q:'$T!("^"[X) I $P("^ALL",X)="" W $P("^ALL",X,2) S I1="ALL",I9="ALL PROVIDERS" D D Q
S:X["?" HELP="PROVRP" D:X["?" ^PSIVHLP1 G:X["?" P S DIC(0)="QEM",DIC="^VA(200,",DIC("S")="I $D(^(""PS""))" D ^DIC K DIC G:Y<0 P S I1=+Y,I9=$P(Y,"^",2) D D
Q
;
D ;Select drug
W !!,"Select DRUG:",!?5,"or ^ALL (All drugs):",!?5,"or ^NON (Non-formulary drugs):",!?5,"or ^CAT (Category of drugs):",!?5,"or ^VADC (VA drug class):" W:$D(PSIVDCR) !?5,"or ^HIGH (H/L cost):",!?5,"or ^TYPE (IV type):" R X:DTIME Q:'$T!("^"[X)
I $D(PSIVDCR),X["^" F Y="^HIGH" I $P(Y,X)="" W $P(Y,X,2) D HI G:Y<0 D S I2="HIGH",I10="HIGH/LOW COST RANGE: "_"$"_LCO_" THROUGH "_"$"_UCO G PQ
I $D(PSIVDCR),X["^" F Y="^TYPE" I $P(Y,X)="" W $P(Y,X,2) D T G:Y<0 D S I2=Y,I10="IV TYPE: "_Y(0) K PQ G PQ
I X["^" F Y="^ALL","^NON","^CAT","^VADC" I $P(Y,X)="" W $P(Y,X,2) D:Y="^CAT" CAT D:Y="^VADC" VADC Q:Y<0 S I2=$E(Y,2,999) S:'$D(I10) I10=$S(Y["NON":"NON-FORMULARY DRUGS",1:"ALL DRUGS") G PQ
I X["?" S HELP="DCR" D ^PSIVHLP2 G D
F DIC=52.6,52.7 S DIC(0)="QEMZ" D ^DIC G:X["?"&(DIC[7) D I Y>0 S I10=$P(Y,U,2) Q
G:Y<0 D S I2=$P(Y(0),U,2)
;
PQ ;Ask for patient data for drug cost report but not if 'TYPE' selected
;or a brief or summary only report is requested
Q:'$D(PQ) F Q=0:0 S HELP="PATQ" W !!,"Should this report include patient data" S %=2 D YN^DICN Q:% S HELP="PATQ" D ^PSIVHLP1
S:%<0 (PQ,X)="^" K:%=2 PQ S:%=1 PQ="Y" Q
;
PAT ;Ask patient for patient cost report
D ENGETP^PSIV S (X,I5)=DFN Q
;
I3 ;Select ward for ward cost report
W !! R "Select WARD",!?5,"or enter ^ALL (all wards)",!?5,"or enter ^OUTPATIENT (outpatient ward): ",X:DTIME W:'$T $C(7) Q:'$T!("^"[X) I $P("^ALL",X)="" W $P("^ALL",X,2) S I3="ALL",I11="ALL WARDS" Q
I $P("^OUTPATIENT",X)="" W $P("^OUTPATIENT",X,2) S I3=.5,I11="WARD: OUTPATIENT" Q
I X["?" S HELP="WARD" D ^PSIVHLP1 G I3
S DIC(0)="QEM",DIC="^DIC(42," D ^DIC K DIC G:Y<0 I3 S I3=+Y,I11="WARD: "_$P(Y,U,2) Q
;
CAT ;Category of drugs
W ! S DIC="^PS(50.2,",DIC(0)="AEQ" D ^DIC I Y>0 S I10="IV CATEGORY: "_$P(Y,U,2),Y="^C."_+Y
Q
;
VADC ;Va drug class codes
W ! S DIC="^PS(50.605,",DIC(0)="AEQ" D ^DIC I Y>0 S I10="VA DRUG CLASS CODE: "_$P(Y,U,2)_" = "_$P(^PS(50.605,+Y,0),U,2),Y="^V."_$P(Y,U,2)
Q
HI ;High low cost
K DIR S DIR(0)="NAO^-999999999999:999999999999:2",DIR("A")="SELECT UPPER COST BOUND: ",DIR("?")="ENTER A NUMBER BETWEEN -999999999999 AND 999999999999" D ^DIR I $D(DIRUT) S Y=-1 Q
S Y=1,UCO=X,X=1
S DIR("A")="SELECT LOWER COST BOUND: " D ^DIR I $D(DIRUT) S Y=-1 Q
I X>UCO W $C(7),!,"LOWER COST BOUND MUST BE LESS THAN UPPER COST BOUND!" G HI
K DIR S Y=1,LCO=X,X=1
Q
;
T ;Type
K DA,DIR S DIR(0)="55.01,.04O",DIR("A")="Select IV TYPE" W ! D ^DIR I "^"'[X S Y="T."_Y
E S Y=-1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSIVRQ1 4031 printed Dec 13, 2024@02:05:02 Page 2
PSIVRQ1 ;BIR/PR-CONT. REPORT DRIVER ;16 DEC 97 / 1:40 PM
+1 ;;5.0; INPATIENT MEDICATIONS ;**31**;16 DEC 97
+2 ;
+3 ; Reference to ^PS(50.605 is supported by DBIA #2138
+4 ;
+5 if $DATA(PSIVDCR)
DO D
if $DATA(PSIVPCR)
DO P
if $DATA(PSIVPAT)
DO PAT
IF $DATA(PSIVWCR)
DO D
if "^"[X
QUIT
DO I3
+6 if "^"[X!(X<0)
GOTO K^PSIVRQ
QUEUE ;Queue logic
+1 WRITE !
KILL IO("Q"),%ZIS,IOP
SET %ZIS("B")=PSIVPR
SET %ZIS="QM"
DO ^%ZIS
IF POP
WRITE !,"NO DEVICE SELECTED OR REPORT PRINTED"
GOTO K^PSIVRQ
+2 if '$DATA(IO("Q"))
GOTO NQ
SET ZTRTN=$SELECT($DATA(PSIVPCR):"^PSIVPCR",$DATA(PSIVDCR):"^PSIVDCR",$DATA(PSIVWCR):"^PSIVWCR",$DATA(PSIVPAT):"^PSIVPAT",1:"^PSIVAMIS")
+3 KILL ZTDTH,ZTSAVE,ZTSK
SET ZTIO=""
SET I6=$SELECT($GET(IO("DOC"))'="":ION_";"_IO("DOC"),1:ION)
SET ZTDESC="IV "_$SELECT($DATA(PSIVPCR):"PROVIDER DRUG COST",$DATA(PSIVDCR):"DRUG COST",$DATA(PSIVWCR):"WARD/DRUG COST",$DATA(PSIVPAT):"PATIENT COST",1:"AMIS")_" REPORT (SORT)"
+4 FOR G="PQ","I2","BRIEF","SMO","I3","I1","I5","I7","I8","I6","I9","I10","I11","I15","I4","UCO","LCO","PSIVPR","PSJSYSU","PSJSYSP0"
SET ZTSAVE(G)=""
+5 KILL IO("Q")
DO ^%ZTLOAD
if $DATA(ZTSK)
WRITE !,"Queued."
DO ^%ZISC
GOTO K^PSIVRQ
+6 ;
NQ ;No queue so run report
+1 DO @($SELECT($DATA(PSIVPCR):"^PSIVPCR",$DATA(PSIVDCR):"^PSIVDCR",$DATA(PSIVPAT):"^PSIVPAT",$DATA(PSIVWCR):"^PSIVWCR",1:"^PSIVAMIS"))
+2 GOTO K^PSIVRQ
+3 ;
P ;Select provider for provider report
+1 READ !!,"Select PROVIDER (or enter ^ALL): ",X:DTIME
if '$TEST
WRITE $CHAR(7)
if '$TEST!("^"[X)
QUIT
IF $PIECE("^ALL",X)=""
WRITE $PIECE("^ALL",X,2)
SET I1="ALL"
SET I9="ALL PROVIDERS"
DO D
QUIT
+2 if X["?"
SET HELP="PROVRP"
if X["?"
DO ^PSIVHLP1
if X["?"
GOTO P
SET DIC(0)="QEM"
SET DIC="^VA(200,"
SET DIC("S")="I $D(^(""PS""))"
DO ^DIC
KILL DIC
if Y<0
GOTO P
SET I1=+Y
SET I9=$PIECE(Y,"^",2)
DO D
+3 QUIT
+4 ;
D ;Select drug
+1 WRITE !!,"Select DRUG:",!?5,"or ^ALL (All drugs):",!?5,"or ^NON (Non-formulary drugs):",!?5,"or ^CAT (Category of drugs):",!?5,"or ^VADC (VA drug class):"
if $DATA(PSIVDCR)
WRITE !?5,"or ^HIGH (H/L cost):",!?5,"or ^TYPE (IV type):"
READ X:DTIME
if '$TEST!("^"[X)
QUIT
+2 IF $DATA(PSIVDCR)
IF X["^"
FOR Y="^HIGH"
IF $PIECE(Y,X)=""
WRITE $PIECE(Y,X,2)
DO HI
if Y<0
GOTO D
SET I2="HIGH"
SET I10="HIGH/LOW COST RANGE: "_"$"_LCO_" THROUGH "_"$"_UCO
GOTO PQ
+3 IF $DATA(PSIVDCR)
IF X["^"
FOR Y="^TYPE"
IF $PIECE(Y,X)=""
WRITE $PIECE(Y,X,2)
DO T
if Y<0
GOTO D
SET I2=Y
SET I10="IV TYPE: "_Y(0)
KILL PQ
GOTO PQ
+4 IF X["^"
FOR Y="^ALL","^NON","^CAT","^VADC"
IF $PIECE(Y,X)=""
WRITE $PIECE(Y,X,2)
if Y="^CAT"
DO CAT
if Y="^VADC"
DO VADC
if Y<0
QUIT
SET I2=$EXTRACT(Y,2,999)
if '$DATA(I10)
SET I10=$SELECT(Y["NON":"NON-FORMULARY DRUGS",1:"ALL DRUGS")
GOTO PQ
+5 IF X["?"
SET HELP="DCR"
DO ^PSIVHLP2
GOTO D
+6 FOR DIC=52.6,52.7
SET DIC(0)="QEMZ"
DO ^DIC
if X["?"&(DIC[7)
GOTO D
IF Y>0
SET I10=$PIECE(Y,U,2)
QUIT
+7 if Y<0
GOTO D
SET I2=$PIECE(Y(0),U,2)
+8 ;
PQ ;Ask for patient data for drug cost report but not if 'TYPE' selected
+1 ;or a brief or summary only report is requested
+2 if '$DATA(PQ)
QUIT
FOR Q=0:0
SET HELP="PATQ"
WRITE !!,"Should this report include patient data"
SET %=2
DO YN^DICN
if %
QUIT
SET HELP="PATQ"
DO ^PSIVHLP1
+3 if %<0
SET (PQ,X)="^"
if %=2
KILL PQ
if %=1
SET PQ="Y"
QUIT
+4 ;
PAT ;Ask patient for patient cost report
+1 DO ENGETP^PSIV
SET (X,I5)=DFN
QUIT
+2 ;
I3 ;Select ward for ward cost report
+1 WRITE !!
READ "Select WARD",!?5,"or enter ^ALL (all wards)",!?5,"or enter ^OUTPATIENT (outpatient ward): ",X:DTIME
if '$TEST
WRITE $CHAR(7)
if '$TEST!("^"[X)
QUIT
IF $PIECE("^ALL",X)=""
WRITE $PIECE("^ALL",X,2)
SET I3="ALL"
SET I11="ALL WARDS"
QUIT
+2 IF $PIECE("^OUTPATIENT",X)=""
WRITE $PIECE("^OUTPATIENT",X,2)
SET I3=.5
SET I11="WARD: OUTPATIENT"
QUIT
+3 IF X["?"
SET HELP="WARD"
DO ^PSIVHLP1
GOTO I3
+4 SET DIC(0)="QEM"
SET DIC="^DIC(42,"
DO ^DIC
KILL DIC
if Y<0
GOTO I3
SET I3=+Y
SET I11="WARD: "_$PIECE(Y,U,2)
QUIT
+5 ;
CAT ;Category of drugs
+1 WRITE !
SET DIC="^PS(50.2,"
SET DIC(0)="AEQ"
DO ^DIC
IF Y>0
SET I10="IV CATEGORY: "_$PIECE(Y,U,2)
SET Y="^C."_+Y
+2 QUIT
+3 ;
VADC ;Va drug class codes
+1 WRITE !
SET DIC="^PS(50.605,"
SET DIC(0)="AEQ"
DO ^DIC
IF Y>0
SET I10="VA DRUG CLASS CODE: "_$PIECE(Y,U,2)_" = "_$PIECE(^PS(50.605,+Y,0),U,2)
SET Y="^V."_$PIECE(Y,U,2)
+2 QUIT
HI ;High low cost
+1 KILL DIR
SET DIR(0)="NAO^-999999999999:999999999999:2"
SET DIR("A")="SELECT UPPER COST BOUND: "
SET DIR("?")="ENTER A NUMBER BETWEEN -999999999999 AND 999999999999"
DO ^DIR
IF $DATA(DIRUT)
SET Y=-1
QUIT
+2 SET Y=1
SET UCO=X
SET X=1
+3 SET DIR("A")="SELECT LOWER COST BOUND: "
DO ^DIR
IF $DATA(DIRUT)
SET Y=-1
QUIT
+4 IF X>UCO
WRITE $CHAR(7),!,"LOWER COST BOUND MUST BE LESS THAN UPPER COST BOUND!"
GOTO HI
+5 KILL DIR
SET Y=1
SET LCO=X
SET X=1
+6 QUIT
+7 ;
T ;Type
+1 KILL DA,DIR
SET DIR(0)="55.01,.04O"
SET DIR("A")="Select IV TYPE"
WRITE !
DO ^DIR
IF "^"'[X
SET Y="T."_Y
+2 IF '$TEST
SET Y=-1
+3 QUIT
