- PSGDCT ;BIR/CML3-DRUG COST TOTALS ; 24 Mar 98 / 10:10 AM
- ;;5.0; INPATIENT MEDICATIONS ;**9,50,91**;16 DEC 97
- ; Reference to ^PS(50.606 supported by DBIA# 2174.
- ; Reference to ^PS(50.7 supported by DBIA# 2180.
- ; Reference to ^PS(50.605 is supported by DBIA# 2138.
- ; Reference to ^PSDRUG is supported by DBIA# 2192.
- ;
- D ENCV^PSGSETU Q:$D(XQUIT)
- S HLP="DRUG COST" D ENDTS^PSGAMS G:'SD!'FD DONE K PSGERR D QUES I $D(PSGERR) W " not selected, DRUG report terminated...",$C(7) G DONE
- S RTN="DCT" D EN3^PSGTI I 'POP,'$D(IO("Q")) D ENQ D:IO'=IO(0)!($E(IOST)'="C") ^%ZISC
- ;
- DONE ;
- D DONE1^PSGDCTP
- Q
- ;
- ENQ ;
- D ^PSGDCT1,^PSGDCTP
- Q
- ;
- QUES ;
- K DIR,PSGDCLW S DIR(0)="Y",DIR("A")="Select by Ward? (Y/N):",DIR("B")="NO",DIR("??")="^D WDHLP^PSGDCT1" D ^DIR K DIR I $D(DIRUT) S PSGERR=1 W !!,"...Ward" Q
- I Y D G:'$D(PSGDCLW) QUES
- .K DIR S DIR(0)="FAO",DIR("A")="Select WARD: ",DIR("B")="ALL",DIR("?")="^D DIC^PSGDCT(""^DIC(42,"",""PSGDCLW"",""WARD"")" W !! D ^DIR K DIR I Y="ALL" S PSGDCLW="ALL" Q
- .D DIC("^DIC(42,","PSGDCLW","WARD") K:'$O(PSGDCLW(0)) PSGDCLW
- ;
- ; ask 'sort by', 'cost limit', and 'dispensing amount limit' questions
- K DIR S DIR(0)="SAO^1:DISPENSE DRUG;2:ORDERABLE ITEM;3:VA CLASS",DIR("A")="Select drugs by DISPENSE DRUG, ORDERABLE ITEM, or VA CLASS: ",DIR("?")="^D ENQH^PSGDCT1" W ! D ^DIR K DIR I 'Y S PSGERR=1 W !!,"...Select category" Q
- S PSGDCT=Y,PSGDCT(1)=$S(PSGDCT=1:"DISPENSED DRUG",PSGDCT=2:"ORDERABLE ITEM",1:"VA CLASS"),X=PSGDCT(1) D LC S PSGDCT(2)=X K X,Y
- ;
- SH ;Select entries to be included..
- K DIR S DIR(0)="FAO",DIR("A")="Select "_PSGDCT(2)_": ",DIR("B")="ALL",PSG=$S(PSGDCT=1:"^PSDRUG(",PSGDCT=2:"^PS(50.7,",1:"^PS(50.605,"),DIR("?")="^D DIC^PSGDCT("""_PSG_""",""PSGDCLW"","""_PSGDCT(1)_""")"
- W !! D ^DIR K DIR I $D(DIRUT) W !!,"...",PSGDCT(1)," not selected" S PSGERR=1 Q
- I Y="ALL" S PSGDCTD=Y
- E D DIC(PSG,"PSGDCTD",PSGDCT(1)) G:$O(PSGDCTD(0))="" SH
- I PSGDCT>1 D DISP Q:$D(PSGERR)
- ;
- SB ;
- I $G(PSGDCTD)'="ALL" D I X<2 S PSGDCTS="N",(PSGDCTA,PSGDCTL)="" Q
- .S Y="" F X=0:1 S Y=$O(PSGDCTD(Y)) Q:Y=""
- K DIR S DIR(0)="SOA^1:"_PSGDCT(1)_";2:COST;3:AMOUNT DISPENSED",DIR("A")="Sort drugs by "_PSGDCT(1)_", COST, or AMOUNT DISPENSED: ",DIR("??")="^D SBCHK^PSGDCT1" D ^DIR K DIR I $D(DIRUT) W !!,"...Sort order" S PSGERR=1 Q
- S PSGDCTS=$S(Y=3:"A",Y=2:"C",1:"N")
- ;
- CL F R !!,"Print all drugs costing at least? ",PSGDCTL:DTIME W:'$T $C(7) S:'$T PSGDCTL="^" Q:"^"[PSGDCTL!(PSGDCTL?.1"-".N.1".".2N) D:PSGDCTL?1."?" CLM^PSGDCT1 W:PSGDCTL'?1."?" $C(7),$C(7)," ??"
- W:PSGDCTL="" " (ALL)" I PSGDCTL="^" S PSGERR=1 W !!,"...Cost limit" S PSGERR=1 Q
- ;
- AL F R !!,"Print all drugs with a dispensing amount of at least? ",PSGDCTA:DTIME W:'$T $C(7) S:'$T PSGDCTA="^" Q:"^"[PSGDCTA!(PSGDCTA?.1"-"1.N) D:PSGDCTA?1."?" ALM^PSGDCT1 W:PSGDCTA'?1."?" $C(7),$C(7)," ??"
- W:PSGDCTA="" " (ALL)" I PSGDCTA="^" W !!,"...Dispensing amount" S PSGERR=1 Q
- Q
- ;
- DISP ;view dispensed drugs
- F W !!,"Display the dispense drugs" S %=1 D YN^DICN Q:% W !!,"Answer 'YES' and I will display the dispensed drugs associated with the ",!,PSGDCT(1)," or answer 'NO' and only the totals will be displayed.",!
- I %<0 S PSGERR=1 W !!,"...Dispense drug display" Q
- K PSGDISP S:%=1 PSGDISP=1
- Q
- ;
- DIC(PSG,PSGDC,PSGT) ;LooK up a ward or report types.
- K DIC,@PSGDC S @PSGDC=1,DIC=PSG,DIC(0)="QEMZ"
- ;if Orderable Item, display the IV identifier
- I DIC="^PS(50.7," D
- .;/IV flag and Identifier is no longer used after POE changes
- .;/S PSJIDD=$P($G(^PS(59.7,1,31)),"^",2)
- .;/S DIC("W")="W "" ""_$P(^PS(50.606,$P(^PS(50.7,+Y,0),""^"",2),0),""^"")_$S($P(^PS(50.7,+Y,0),""^"",3):"" ""_$G(PSJIDD),1:"""")_"
- .S DIC("W")="W "" ""_$P(^PS(50.606,$P(^PS(50.7,+Y,0),""^"",2),0),""^"")_"
- .S DIC("W")=DIC("W")_""" ""_$S($P(^PS(50.7,+Y,0),""^"",4):$E($P(^(0),""^"",4),4,5)_""-""_$E($P(^(0),""^"",4),6,7)_""-""_$E($P(^(0),""^"",4),2,3),1:"""")"
- ;/F D ^DIC K PSJIDD Q:Y<0 S DIC(0)=DIC(0)_"A",DIC("A")="Select another "_PSGT_": " S X=PSGDC_"("""_$S($G(PSGDCT)=3:$P(Y(0),U),1:+Y)_""")",@X=Y(0,0)
- F D ^DIC Q:Y<0 S DIC(0)=DIC(0)_"A",DIC("A")="Select another "_PSGT_": " S X=PSGDC_"("""_$S($G(PSGDCT)=3:$P(Y(0),U),1:+Y)_""")",@X=Y(0,0)
- Q
- ;
- LC ;Convert data to lower case wording
- F %=2:1:$L(X) I $E(X,%)?1U,$E(X,%-1)?1A,$E(X,%-1)'="V" S X=$E(X,0,%-1)_$C($A(X,%)+32)_$E(X,%+1,999)
- Q
- PSGDCT ;BIR/CML3-DRUG COST TOTALS ; 24 Mar 98 / 10:10 AM
- +1 ;;5.0; INPATIENT MEDICATIONS ;**9,50,91**;16 DEC 97
- +2 ; Reference to ^PS(50.606 supported by DBIA# 2174.
- +3 ; Reference to ^PS(50.7 supported by DBIA# 2180.
- +4 ; Reference to ^PS(50.605 is supported by DBIA# 2138.
- +5 ; Reference to ^PSDRUG is supported by DBIA# 2192.
- +6 ;
- +7 DO ENCV^PSGSETU
- IF $DATA(XQUIT)
- QUIT
- +8 SET HLP="DRUG COST"
- DO ENDTS^PSGAMS
- IF 'SD!'FD
- GOTO DONE
- KILL PSGERR
- DO QUES
- IF $DATA(PSGERR)
- WRITE " not selected, DRUG report terminated...",$CHAR(7)
- GOTO DONE
- +9 SET RTN="DCT"
- DO EN3^PSGTI
- IF 'POP
- IF '$DATA(IO("Q"))
- DO ENQ
- IF IO'=IO(0)!($EXTRACT(IOST)'="C")
- DO ^%ZISC
- +10 ;
- DONE ;
- +1 DO DONE1^PSGDCTP
- +2 QUIT
- +3 ;
- ENQ ;
- +1 DO ^PSGDCT1
- DO ^PSGDCTP
- +2 QUIT
- +3 ;
- QUES ;
- +1 KILL DIR,PSGDCLW
- SET DIR(0)="Y"
- SET DIR("A")="Select by Ward? (Y/N):"
- SET DIR("B")="NO"
- SET DIR("??")="^D WDHLP^PSGDCT1"
- DO ^DIR
- KILL DIR
- IF $DATA(DIRUT)
- SET PSGERR=1
- WRITE !!,"...Ward"
- QUIT
- +2 IF Y
- Begin DoDot:1
- +3 KILL DIR
- SET DIR(0)="FAO"
- SET DIR("A")="Select WARD: "
- SET DIR("B")="ALL"
- SET DIR("?")="^D DIC^PSGDCT(""^DIC(42,"",""PSGDCLW"",""WARD"")"
- WRITE !!
- DO ^DIR
- KILL DIR
- IF Y="ALL"
- SET PSGDCLW="ALL"
- QUIT
- +4 DO DIC("^DIC(42,","PSGDCLW","WARD")
- IF '$ORDER(PSGDCLW(0))
- KILL PSGDCLW
- End DoDot:1
- IF '$DATA(PSGDCLW)
- GOTO QUES
- +5 ;
- +6 ; ask 'sort by', 'cost limit', and 'dispensing amount limit' questions
- +7 KILL DIR
- SET DIR(0)="SAO^1:DISPENSE DRUG;2:ORDERABLE ITEM;3:VA CLASS"
- SET DIR("A")="Select drugs by DISPENSE DRUG, ORDERABLE ITEM, or VA CLASS: "
- SET DIR("?")="^D ENQH^PSGDCT1"
- WRITE !
- DO ^DIR
- KILL DIR
- IF 'Y
- SET PSGERR=1
- WRITE !!,"...Select category"
- QUIT
- +8 SET PSGDCT=Y
- SET PSGDCT(1)=$SELECT(PSGDCT=1:"DISPENSED DRUG",PSGDCT=2:"ORDERABLE ITEM",1:"VA CLASS")
- SET X=PSGDCT(1)
- DO LC
- SET PSGDCT(2)=X
- KILL X,Y
- +9 ;
- SH ;Select entries to be included..
- +1 KILL DIR
- SET DIR(0)="FAO"
- SET DIR("A")="Select "_PSGDCT(2)_": "
- SET DIR("B")="ALL"
- SET PSG=$SELECT(PSGDCT=1:"^PSDRUG(",PSGDCT=2:"^PS(50.7,",1:"^PS(50.605,")
- SET DIR("?")="^D DIC^PSGDCT("""_PSG_""",""PSGDCLW"","""_PSGDCT(1)_""")"
- +2 WRITE !!
- DO ^DIR
- KILL DIR
- IF $DATA(DIRUT)
- WRITE !!,"...",PSGDCT(1)," not selected"
- SET PSGERR=1
- QUIT
- +3 IF Y="ALL"
- SET PSGDCTD=Y
- +4 IF '$TEST
- DO DIC(PSG,"PSGDCTD",PSGDCT(1))
- IF $ORDER(PSGDCTD(0))=""
- GOTO SH
- +5 IF PSGDCT>1
- DO DISP
- IF $DATA(PSGERR)
- QUIT
- +6 ;
- SB ;
- +1 IF $GET(PSGDCTD)'="ALL"
- Begin DoDot:1
- +2 SET Y=""
- FOR X=0:1
- SET Y=$ORDER(PSGDCTD(Y))
- IF Y=""
- QUIT
- End DoDot:1
- IF X<2
- SET PSGDCTS="N"
- SET (PSGDCTA,PSGDCTL)=""
- QUIT
- +3 KILL DIR
- SET DIR(0)="SOA^1:"_PSGDCT(1)_";2:COST;3:AMOUNT DISPENSED"
- SET DIR("A")="Sort drugs by "_PSGDCT(1)_", COST, or AMOUNT DISPENSED: "
- SET DIR("??")="^D SBCHK^PSGDCT1"
- DO ^DIR
- KILL DIR
- IF $DATA(DIRUT)
- WRITE !!,"...Sort order"
- SET PSGERR=1
- QUIT
- +4 SET PSGDCTS=$SELECT(Y=3:"A",Y=2:"C",1:"N")
- +5 ;
- CL FOR
- READ !!,"Print all drugs costing at least? ",PSGDCTL:DTIME
- IF '$TEST
- WRITE $CHAR(7)
- IF '$TEST
- SET PSGDCTL="^"
- IF "^"[PSGDCTL!(PSGDCTL?.1"-".N.1".".2N)
- QUIT
- IF PSGDCTL?1."?"
- DO CLM^PSGDCT1
- IF PSGDCTL'?1."?"
- WRITE $CHAR(7),$CHAR(7)," ??"
- +1 IF PSGDCTL=""
- WRITE " (ALL)"
- IF PSGDCTL="^"
- SET PSGERR=1
- WRITE !!,"...Cost limit"
- SET PSGERR=1
- QUIT
- +2 ;
- AL FOR
- READ !!,"Print all drugs with a dispensing amount of at least? ",PSGDCTA:DTIME
- IF '$TEST
- WRITE $CHAR(7)
- IF '$TEST
- SET PSGDCTA="^"
- IF "^"[PSGDCTA!(PSGDCTA?.1"-"1.N)
- QUIT
- IF PSGDCTA?1."?"
- DO ALM^PSGDCT1
- IF PSGDCTA'?1."?"
- WRITE $CHAR(7),$CHAR(7)," ??"
- +1 IF PSGDCTA=""
- WRITE " (ALL)"
- IF PSGDCTA="^"
- WRITE !!,"...Dispensing amount"
- SET PSGERR=1
- QUIT
- +2 QUIT
- +3 ;
- DISP ;view dispensed drugs
- +1 FOR
- WRITE !!,"Display the dispense drugs"
- SET %=1
- DO YN^DICN
- IF %
- QUIT
- WRITE !!,"Answer 'YES' and I will display the dispensed drugs associated with the ",!,PSGDCT(1)," or answer 'NO' and only the totals will be displayed.",!
- +2 IF %<0
- SET PSGERR=1
- WRITE !!,"...Dispense drug display"
- QUIT
- +3 KILL PSGDISP
- IF %=1
- SET PSGDISP=1
- +4 QUIT
- +5 ;
- DIC(PSG,PSGDC,PSGT) ;LooK up a ward or report types.
- +1 KILL DIC,@PSGDC
- SET @PSGDC=1
- SET DIC=PSG
- SET DIC(0)="QEMZ"
- +2 ;if Orderable Item, display the IV identifier
- +3 IF DIC="^PS(50.7,"
- Begin DoDot:1
- +4 ;/IV flag and Identifier is no longer used after POE changes
- +5 ;/S PSJIDD=$P($G(^PS(59.7,1,31)),"^",2)
- +6 ;/S DIC("W")="W "" ""_$P(^PS(50.606,$P(^PS(50.7,+Y,0),""^"",2),0),""^"")_$S($P(^PS(50.7,+Y,0),""^"",3):"" ""_$G(PSJIDD),1:"""")_"
- +7 SET DIC("W")="W "" ""_$P(^PS(50.606,$P(^PS(50.7,+Y,0),""^"",2),0),""^"")_"
- +8 SET DIC("W")=DIC("W")_""" ""_$S($P(^PS(50.7,+Y,0),""^"",4):$E($P(^(0),""^"",4),4,5)_""-""_$E($P(^(0),""^"",4),6,7)_""-""_$E($P(^(0),""^"",4),2,3),1:"""")"
- End DoDot:1
- +9 ;/F D ^DIC K PSJIDD Q:Y<0 S DIC(0)=DIC(0)_"A",DIC("A")="Select another "_PSGT_": " S X=PSGDC_"("""_$S($G(PSGDCT)=3:$P(Y(0),U),1:+Y)_""")",@X=Y(0,0)
- +10 FOR
- DO ^DIC
- IF Y<0
- QUIT
- SET DIC(0)=DIC(0)_"A"
- SET DIC("A")="Select another "_PSGT_": "
- SET X=PSGDC_"("""_$SELECT($GET(PSGDCT)=3:$PIECE(Y(0),U),1:+Y)_""")"
- SET @X=Y(0,0)
- +11 QUIT
- +12 ;
- LC ;Convert data to lower case wording
- +1 FOR %=2:1:$LENGTH(X)
- IF $EXTRACT(X,%)?1U
- IF $EXTRACT(X,%-1)?1A
- IF $EXTRACT(X,%-1)'="V"
- SET X=$EXTRACT(X,0,%-1)_$CHAR($ASCII(X,%)+32)_$EXTRACT(X,%+1,999)
- +2 QUIT
