- 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 Feb 18, 2025@23:31:25 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