- PSAPSI2 ;BIR/LTL-IV Dispensing (All Drugs) ;7/23/97
- ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**3,15**; 10/24/97
- ;This routine gathers IV dispensing for all drugs in a pharmacy location.
- ;
- ;References to ^PSDRUG( are covered by IA #2095
- ;References to ^PS(50.8 are covered by IA #771
- ;References to ^PS(52.6 are covered by IA #270
- ;References to ^PS(52.7 are covered by IA #770
- ;
- K PSAQUIT D PSAWARN^PSAPSI I $D(PSAQUIT) K PSAQUIT Q
- N DIC,DIE,DINUM,D0,D1,DLAYGO,DR,DIR,DIRUT,DTOUT,DUOUT,PSAPG,PSALN,PSALOCN,PSAS,PSA,PSAOUT,PSADT,DA,PSADRUG,PSADRUGN,PSAQ,PSAIV,PSAW,X,X2,Y,ZTSK
- LOOK D ^PSADA G:'$G(PSALOC) QUIT
- I '$O(^PSD(58.8,+PSALOC,1,0)) W !!,"There are no drugs in ",PSALOCN,!! G QUIT
- D NOW^%DTC S PSADT=X,X="T-6000" D ^%DT S PSADT(1)=Y,(PSAPG,PSAOUT,PSADRUG)=0
- S DIR(0)="D^"_PSADT(1)_":"_PSADT_":AEX",DIR("A")="How far back would you like to collect",DIR("B")="T-6000" D ^DIR K DIR S (PSADT(2),PSAR)=Y,(PSADT(3),PSAR(1))=0 I Y<1 S PSAOUT=1 Q
- S (PSADT(22),PSADT(23),PSAIV)=0
- S DIR(0)="Y",DIR("A")="Would you like a report of daily dispensing totals",DIR("B")="Yes" D ^DIR K DIR S:$D(DIRUT) PSAOUT=1 G:$D(DIRUT) STOP
- I Y'=1 S PSA(5)=1,ZTIO="",ZTRTN="LUP^PSAPSI2",ZTDESC="DA drug disp",ZTSAVE("PSA*")="",ZTDTH=$H D ^%ZTLOAD,HOME^%ZIS S PSAOUT=1 G STOP
- DEV K IO("Q") N %ZIS,IOP,POP S %ZIS="Q" I Y=1 W ! D ^%ZIS
- I $G(POP) W !,"NO DEVICE SELECTED OR ACTION TAKEN!" S PSAOUT=1 G QUIT
- I $D(IO("Q")) N ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTDTH S ZTRTN="LUP^PSAPSI2",ZTDESC="Daily drug dispensing",ZTSAVE("PSA*")="" D ^%ZTLOAD,HOME^%ZIS S PSAOUT=1 G STOP
- LUP F S PSADRUG=$O(^PSD(58.8,+PSALOC,1,PSADRUG)) Q:'PSADRUG D:$Y+5>$G(IOSL)&('$G(PSA(5))) HEADER G:$G(PSAOUT) STOP D:$S($P($G(^PSD(58.8,+PSALOC,1,+PSADRUG,0)),U,14):$P($G(^(0)),U,14)>DT,1:1) D:$D(^TMP("PSA",$J,+PSADRUG)) TASK
- .Q:$P($G(^PSD(58.8,+PSALOC,1,+PSADRUG,6)),U,3)
- .S PSADRUGN=$P($G(^PSDRUG(+PSADRUG,0)),U),PSAIV=0
- .I '$G(PSA(5))&('$G(PSAPG)) W @IOF D HEADER
- .S PSADT(3)=0,PSA(7)=1
- .I '$O(^PS(52.6,"AC",+PSADRUG,0))&('$O(^PS(52.7,"AC",+PSADRUG,0)))&('$G(PSA(5))) Q
- .S PSADRUG(1)=$O(^PS(52.6,"AC",+PSADRUG,0))
- .S PSADRUG(2)=$O(^PS(52.7,"AC",+PSADRUG,0))
- .S PSAW=PSADT(3)
- .F S PSAIV=$O(^PS(50.8,PSAIV)) Q:'PSAIV F PSADT(4)=PSADT(2):0 S PSADT(4)=$O(^PS(50.8,+PSAIV,2,PSADT(4))) Q:'PSADT(4) D D:$O(^PS(50.8,+PSAIV,2,+PSADT(4),2,"AC",52.7,+PSADRUG(2),0)) SOL
- ..Q:'$O(^PS(50.8,+PSAIV,2,+PSADT(4),2,"AC",52.6,+PSADRUG(1),0))
- ..S PSADRUG(3)=$O(^PS(50.8,+PSAIV,2,+PSADT(4),2,"AC",52.6,+PSADRUG(1),0))
- ..F S PSAW=$O(^PS(50.8,+PSAIV,2,+PSADT(4),2,+PSADRUG(3),3,PSAW)) Q:'PSAW S PSAW(1)=PSAW D:$O(^PSD(58.8,"AB",PSAW,0))=PSALOC
- ...S PSAQ=$G(PSAQ)+$P($G(^PS(50.8,+PSAIV,2,+PSADT(4),2,+PSADRUG(3),3,PSAW,0)),U,2)-$P($G(^(0)),U,5)
- ..S:$G(PSAQ) ^TMP("PSA",$J,+PSADRUG,PSADT(4))=$G(^TMP("PSA",$J,+PSADRUG,PSADT(4)))+PSAQ S (PSAQ,PSAW)=0
- .Q:$G(PSA(5))
- .S PSADRUG(1)=$P($G(^PSDRUG(+PSADRUG,660)),U,6),PSADRUG(2)=$P($G(^(660)),U,8)
- .S X=PSADRUG(1),X2="3$" D COMMA^%DTC S PSADRUG(3)=X
- .S (PSA(4),PSA(6))=0 F S PSA(4)=$O(^TMP("PSA",$J,+PSADRUG,PSA(4))) Q:'PSA(4) D:$Y+4>IOSL HEADER Q:PSAOUT S PSA(6)=PSA(6)+1,Y=PSA(4) X ^DD("DD") D
- ..W:$G(PSA(6))=1 !!,PSADRUGN W !!,Y
- ..S (X,PSADRUG(6))=$G(^TMP("PSA",$J,+PSADRUG,PSA(4))),X2=0
- ..S:$P($G(^PSD(58.8,+PSALOC,1,+PSADRUG,6)),U,4) X=X/$P($G(^(6)),U,4)
- ..D COMMA^%DTC W ?14,X,PSADRUG(2),?40,PSADRUG(3),"/",PSADRUG(2),?63
- ..S PSADRUG(4)=$G(PSADRUG(4))+X
- ..S X=X*PSADRUG(1),PSADRUG(5)=$G(PSADRUG(5))+X,X2="2$" D COMMA^%DTC W ?40,X
- .I PSA(6) W !,PSALN,!,PSA(6)," DAY TOTALS: " S X=$G(PSADRUG(4)),X2=0 D COMMA^%DTC W ?5,X,PSADRUG(2) S PSADRUG(4)=0 S X=$G(PSADRUG(5)),X2="2$" D COMMA^%DTC W ?63,X S PSADRUG(5)=0
- I 'PSADRUG&($G(PSA(5))) S PSAOUT=1
- STOP W:$E($G(IOST),1,2)="P-" @IOF
- I $E($G(IOST))="C",'$G(PSAOUT) W ! S DIR(0)="EA",DIR("A")="END OF REPORT! Press <RET> to return to the menu." D ^DIR K DIR
- D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@" K IO("Q")
- K ^TMP("PSA",$J),PSA
- QUIT Q
- I $$S^%ZTLOAD W !!,"Task #",$G(ZTSK),", ",$G(ZTDESC)," was stopped by ",$P($G(^VA(200,+$G(DUZ),0)),U),"." S PSAOUT=1 Q
- W:$Y @IOF S $P(PSALN,"-",81)="",PSAPG=$G(PSAPG)+1 W !,?2,"DAILY DISPENSING TOTALS FOR ",$E($G(PSALOCN),1,30),?70,"PAGE: ",PSAPG,!,PSALN,!
- W " DATE",?23,"TOTAL",?45,"$/DISP",?67,"TOTAL",!
- W "DISPENSED",?23,"DISP",?46,"UNIT",?68,"COST",!,PSALN
- Q
- TASK S ZTIO="",ZTRTN="^PSAPSI1",ZTDTH=$H,ZTDESC="Dispensing totals",(ZTSAVE("^TMP(""PSA"",$J,+PSADRUG,"),ZTSAVE("PSA*"))="" D ^%ZTLOAD,HOME^%ZIS
- W:'$G(PSA(5)) !!,"Updating transaction file and dispensing totals." Q
- SOL S PSAW=PSADT(3),PSADRUG(3)=$O(^PS(50.8,+PSAIV,2,+PSADT(4),2,"AC",52.7,+PSADRUG(2),0))
- F S PSAW=$O(^PS(50.8,+PSAIV,2,+PSADT(4),2,+PSADRUG(3),3,PSAW)) Q:'PSAW S PSAW(1)=PSAW D:$O(^PSD(58.8,"AB",PSAW,0))=PSALOC
- .S PSAQ=$G(PSAQ)+$P($G(^PS(50.8,+PSAIV,2,+PSADT(4),2,+PSADRUG(3),3,PSAW,0)),U,2)-$P($G(^(0)),U,5)
- S:PSAQ ^TMP("PSA",$J,+PSADRUG,PSADT(4))=$G(^TMP("PSA",$J,+PSADRUG,PSADT(4)))+PSAQ S (PSAQ,PSAW)=0
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSAPSI2 5054 printed Feb 18, 2025@23:16:37 Page 2
- PSAPSI2 ;BIR/LTL-IV Dispensing (All Drugs) ;7/23/97
- +1 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**3,15**; 10/24/97
- +2 ;This routine gathers IV dispensing for all drugs in a pharmacy location.
- +3 ;
- +4 ;References to ^PSDRUG( are covered by IA #2095
- +5 ;References to ^PS(50.8 are covered by IA #771
- +6 ;References to ^PS(52.6 are covered by IA #270
- +7 ;References to ^PS(52.7 are covered by IA #770
- +8 ;
- +9 KILL PSAQUIT
- DO PSAWARN^PSAPSI
- IF $DATA(PSAQUIT)
- KILL PSAQUIT
- QUIT
- +10 NEW DIC,DIE,DINUM,D0,D1,DLAYGO,DR,DIR,DIRUT,DTOUT,DUOUT,PSAPG,PSALN,PSALOCN,PSAS,PSA,PSAOUT,PSADT,DA,PSADRUG,PSADRUGN,PSAQ,PSAIV,PSAW,X,X2,Y,ZTSK
- LOOK DO ^PSADA
- if '$GET(PSALOC)
- GOTO QUIT
- +1 IF '$ORDER(^PSD(58.8,+PSALOC,1,0))
- WRITE !!,"There are no drugs in ",PSALOCN,!!
- GOTO QUIT
- +2 DO NOW^%DTC
- SET PSADT=X
- SET X="T-6000"
- DO ^%DT
- SET PSADT(1)=Y
- SET (PSAPG,PSAOUT,PSADRUG)=0
- +3 SET DIR(0)="D^"_PSADT(1)_":"_PSADT_":AEX"
- SET DIR("A")="How far back would you like to collect"
- SET DIR("B")="T-6000"
- DO ^DIR
- KILL DIR
- SET (PSADT(2),PSAR)=Y
- SET (PSADT(3),PSAR(1))=0
- IF Y<1
- SET PSAOUT=1
- QUIT
- +4 SET (PSADT(22),PSADT(23),PSAIV)=0
- +5 SET DIR(0)="Y"
- SET DIR("A")="Would you like a report of daily dispensing totals"
- SET DIR("B")="Yes"
- DO ^DIR
- KILL DIR
- if $DATA(DIRUT)
- SET PSAOUT=1
- if $DATA(DIRUT)
- GOTO STOP
- +6 IF Y'=1
- SET PSA(5)=1
- SET ZTIO=""
- SET ZTRTN="LUP^PSAPSI2"
- SET ZTDESC="DA drug disp"
- SET ZTSAVE("PSA*")=""
- SET ZTDTH=$HOROLOG
- DO ^%ZTLOAD
- DO HOME^%ZIS
- SET PSAOUT=1
- GOTO STOP
- DEV KILL IO("Q")
- NEW %ZIS,IOP,POP
- SET %ZIS="Q"
- IF Y=1
- WRITE !
- DO ^%ZIS
- +1 IF $GET(POP)
- WRITE !,"NO DEVICE SELECTED OR ACTION TAKEN!"
- SET PSAOUT=1
- GOTO QUIT
- +2 IF $DATA(IO("Q"))
- NEW ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTDTH
- SET ZTRTN="LUP^PSAPSI2"
- SET ZTDESC="Daily drug dispensing"
- SET ZTSAVE("PSA*")=""
- DO ^%ZTLOAD
- DO HOME^%ZIS
- SET PSAOUT=1
- GOTO STOP
- LUP FOR
- SET PSADRUG=$ORDER(^PSD(58.8,+PSALOC,1,PSADRUG))
- if 'PSADRUG
- QUIT
- if $Y+5>$GET(IOSL)&('$GET(PSA(5)))
- DO HEADER
- if $GET(PSAOUT)
- GOTO STOP
- if $SELECT($PIECE($GET(^PSD(58.8,+PSALOC,1,+PSADRUG,0)),U,14)
- Begin DoDot:1
- +1 if $PIECE($GET(^PSD(58.8,+PSALOC,1,+PSADRUG,6)),U,3)
- QUIT
- +2 SET PSADRUGN=$PIECE($GET(^PSDRUG(+PSADRUG,0)),U)
- SET PSAIV=0
- +3 IF '$GET(PSA(5))&('$GET(PSAPG))
- WRITE @IOF
- DO HEADER
- +4 SET PSADT(3)=0
- SET PSA(7)=1
- +5 IF '$ORDER(^PS(52.6,"AC",+PSADRUG,0))&('$ORDER(^PS(52.7,"AC",+PSADRUG,0)))&('$GET(PSA(5)))
- QUIT
- +6 SET PSADRUG(1)=$ORDER(^PS(52.6,"AC",+PSADRUG,0))
- +7 SET PSADRUG(2)=$ORDER(^PS(52.7,"AC",+PSADRUG,0))
- +8 SET PSAW=PSADT(3)
- +9 FOR
- SET PSAIV=$ORDER(^PS(50.8,PSAIV))
- if 'PSAIV
- QUIT
- FOR PSADT(4)=PSADT(2):0
- SET PSADT(4)=$ORDER(^PS(50.8,+PSAIV,2,PSADT(4)))
- if 'PSADT(4)
- QUIT
- Begin DoDot:2
- +10 if '$ORDER(^PS(50.8,+PSAIV,2,+PSADT(4),2,"AC",52.6,+PSADRUG(1),0))
- QUIT
- +11 SET PSADRUG(3)=$ORDER(^PS(50.8,+PSAIV,2,+PSADT(4),2,"AC",52.6,+PSADRUG(1),0))
- +12 FOR
- SET PSAW=$ORDER(^PS(50.8,+PSAIV,2,+PSADT(4),2,+PSADRUG(3),3,PSAW))
- if 'PSAW
- QUIT
- SET PSAW(1)=PSAW
- if $ORDER(^PSD(58.8,"AB",PSAW,0))=PSALOC
- Begin DoDot:3
- +13 SET PSAQ=$GET(PSAQ)+$PIECE($GET(^PS(50.8,+PSAIV,2,+PSADT(4),2,+PSADRUG(3),3,PSAW,0)),U,2)-$PIECE($GET(^(0)),U,5)
- End DoDot:3
- +14 if $GET(PSAQ)
- SET ^TMP("PSA",$JOB,+PSADRUG,PSADT(4))=$GET(^TMP("PSA",$JOB,+PSADRUG,PSADT(4)))+PSAQ
- SET (PSAQ,PSAW)=0
- End DoDot:2
- if $ORDER(^PS(50.8,+PSAIV,2,+PSADT(4),2,"AC",52.7,+PSADRUG(2),0))
- DO SOL
- +15 if $GET(PSA(5))
- QUIT
- +16 SET PSADRUG(1)=$PIECE($GET(^PSDRUG(+PSADRUG,660)),U,6)
- SET PSADRUG(2)=$PIECE($GET(^(660)),U,8)
- +17 SET X=PSADRUG(1)
- SET X2="3$"
- DO COMMA^%DTC
- SET PSADRUG(3)=X
- +18 SET (PSA(4),PSA(6))=0
- FOR
- SET PSA(4)=$ORDER(^TMP("PSA",$JOB,+PSADRUG,PSA(4)))
- if 'PSA(4)
- QUIT
- if $Y+4>IOSL
- DO HEADER
- if PSAOUT
- QUIT
- SET PSA(6)=PSA(6)+1
- SET Y=PSA(4)
- XECUTE ^DD("DD")
- Begin DoDot:2
- +19 if $GET(PSA(6))=1
- WRITE !!,PSADRUGN
- WRITE !!,Y
- +20 SET (X,PSADRUG(6))=$GET(^TMP("PSA",$JOB,+PSADRUG,PSA(4)))
- SET X2=0
- +21 if $PIECE($GET(^PSD(58.8,+PSALOC,1,+PSADRUG,6)),U,4)
- SET X=X/$PIECE($GET(^(6)),U,4)
- +22 DO COMMA^%DTC
- WRITE ?14,X,PSADRUG(2),?40,PSADRUG(3),"/",PSADRUG(2),?63
- +23 SET PSADRUG(4)=$GET(PSADRUG(4))+X
- +24 SET X=X*PSADRUG(1)
- SET PSADRUG(5)=$GET(PSADRUG(5))+X
- SET X2="2$"
- DO COMMA^%DTC
- WRITE ?40,X
- End DoDot:2
- +25 IF PSA(6)
- WRITE !,PSALN,!,PSA(6)," DAY TOTALS: "
- SET X=$GET(PSADRUG(4))
- SET X2=0
- DO COMMA^%DTC
- WRITE ?5,X,PSADRUG(2)
- SET PSADRUG(4)=0
- SET X=$GET(PSADRUG(5))
- SET X2="2$"
- DO COMMA^%DTC
- WRITE ?63,X
- SET PSADRUG(5)=0
- End DoDot:1
- if $DATA(^TMP("PSA",$JOB,+PSADRUG))
- DO TASK
- +26 IF 'PSADRUG&($GET(PSA(5)))
- SET PSAOUT=1
- STOP if $EXTRACT($GET(IOST),1,2)="P-"
- WRITE @IOF
- +1 IF $EXTRACT($GET(IOST))="C"
- IF '$GET(PSAOUT)
- WRITE !
- SET DIR(0)="EA"
- SET DIR("A")="END OF REPORT! Press <RET> to return to the menu."
- DO ^DIR
- KILL DIR
- +2 DO ^%ZISC
- if $DATA(ZTQUEUED)
- SET ZTREQ="@"
- KILL IO("Q")
- +3 KILL ^TMP("PSA",$JOB),PSA
- QUIT QUIT
- IF $GET(PSAPG)
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- IF Y<1
- SET PSAOUT=1
- QUIT
- +1 IF $$S^%ZTLOAD
- WRITE !!,"Task #",$GET(ZTSK),", ",$GET(ZTDESC)," was stopped by ",$PIECE($GET(^VA(200,+$GET(DUZ),0)),U),"."
- SET PSAOUT=1
- QUIT
- +2 if $Y
- WRITE @IOF
- SET $PIECE(PSALN,"-",81)=""
- SET PSAPG=$GET(PSAPG)+1
- WRITE !,?2,"DAILY DISPENSING TOTALS FOR ",$EXTRACT($GET(PSALOCN),1,30),?70,"PAGE: ",PSAPG,!,PSALN,!
- +3 WRITE " DATE",?23,"TOTAL",?45,"$/DISP",?67,"TOTAL",!
- +4 WRITE "DISPENSED",?23,"DISP",?46,"UNIT",?68,"COST",!,PSALN
- +5 QUIT
- TASK SET ZTIO=""
- SET ZTRTN="^PSAPSI1"
- SET ZTDTH=$HOROLOG
- SET ZTDESC="Dispensing totals"
- SET (ZTSAVE("^TMP(""PSA"",$J,+PSADRUG,"),ZTSAVE("PSA*"))=""
- DO ^%ZTLOAD
- DO HOME^%ZIS
- +1 if '$GET(PSA(5))
- WRITE !!,"Updating transaction file and dispensing totals."
- QUIT
- SOL SET PSAW=PSADT(3)
- SET PSADRUG(3)=$ORDER(^PS(50.8,+PSAIV,2,+PSADT(4),2,"AC",52.7,+PSADRUG(2),0))
- +1 FOR
- SET PSAW=$ORDER(^PS(50.8,+PSAIV,2,+PSADT(4),2,+PSADRUG(3),3,PSAW))
- if 'PSAW
- QUIT
- SET PSAW(1)=PSAW
- if $ORDER(^PSD(58.8,"AB",PSAW,0))=PSALOC
- Begin DoDot:1
- +2 SET PSAQ=$GET(PSAQ)+$PIECE($GET(^PS(50.8,+PSAIV,2,+PSADT(4),2,+PSADRUG(3),3,PSAW,0)),U,2)-$PIECE($GET(^(0)),U,5)
- End DoDot:1
- +3 if PSAQ
- SET ^TMP("PSA",$JOB,+PSADRUG,PSADT(4))=$GET(^TMP("PSA",$JOB,+PSADRUG,PSADT(4)))+PSAQ
- SET (PSAQ,PSAW)=0
- +4 QUIT
