- AZFMCM1 ;IHS/OHPRD/JCM;COMMON DRUG PRINT[ 02/03/95 2:25 PM ]
- ;;5.06;PS;;JUL 12, 1990
- ;THIS ROUTINE PRINTS THE PHARMACY DRUG LISTING
- ;IT IS CALLED BY AZFMCM
- ;
- ;INPUT VARIABLES: BD,ED,PSZCNT,^TMP("PSOZCOM2",$J)
- ;VARIABLES: I,X,NUM,UTL,DRGNAME
- ;
- ;EXTERNAL CALLS: NOW^%DTC,^%ZIS
- ;
- START ;INITIALIZE
- S (DX,DY)=1 X:$D(^%ZOSF("XY"))#2 ^("XY")
- U IO
- S PSOZCOM1("PAGE")=0,APSPO=""
- D HEADER
- ;
- ;START LOOP
- ;F NUM=0:0 S NUM=$O(^TMP("PSOZCOM2",$J,NUM)) Q:NUM=""!(NUM>PSZCNT) D DRUG
- D DRUG
- ;
- EXIT ;
- I $E(IOST,1,2)="P-" W !,@IOF
- X ^%ZIS("C")
- K NUM,DRGNAME,I,X,BD,ED,PSZCNT,UTL,PSOZCOM1,DX,DY
- Q
- PRINT ;
- I $Y+4>IOSL W @IOF D HEADER
- S UTL=^TMP("PSOZCOM1",$J,DRGNAME,APSPO)
- W !,DRGNAME ;DRUG NAME
- W ?40,$P(UTL,U,3) ;TOTAL FILLS
- W ?47,$P(UTL,U,1) ;NEW RXS
- W ?52,$P(UTL,U,2) ;REFILLS
- W ?60,APSPO,?70,$P(UTL,U,4)
- Q
- DRUG ;
- S DRGNAME=0
- F I=0:0 S DRGNAME=$O(^TMP("PSOZCOM1",$J,DRGNAME)) Q:DRGNAME="" F S APSPO=$O(^TMP("PSOZCOM1",$J,DRGNAME,APSPO)) Q:APSPO="" D PRINT
- Q
- S PSOZCOM1("PAGE")=PSOZCOM1("PAGE")+1
- I $D(DUZ(2)) W !!,$P(^DIC(4,DUZ(2),0),"^",1)," DISPENSED DRUG LIST"
- I '$D(DUZ(2)) W !!,"DISPENSED DRUG LIST"
- W ?73,"Page ",PSOZCOM1("PAGE")
- W !,"DATE OF LISTING: "
- D NOW^%DTC W $E(X,4,5)_"-"_$E(X,6,7)_"-"_$E(X,2,3)
- W !!,"This list includes all prescriptions from "
- W $E(BD,4,5)_"-"_$E(BD,6,7)_"-"_$E(BD,2,3)," through "
- W $E(ED,4,5)_"-"_$E(ED,6,7)_"-"_$E(ED,2,3)_"."
- ;W !,"The drug must have been issued a minimum of * "
- ;W 9999999-PSZCNT," * times to appear on listing.",!!
- W !!,"DRUG",?40,"TOTAL",?47,"NEW",?52,"REFILL",?60,"DISPENSE",?70,"QTY",!,?60,"UNIT"
- W ! F I=1:1:IOM W "-"
- ;I '$D(^TMP("PSOZCOM2",$J)) W !!?20,"NO RXS FOR A DRUG THAT TOTALS OVER COUNT SPECIFIED" ;G EXIT ;IHS/OHPRD/JCM 11/28/89
- W !
- Q
- AZFMCM1 ;IHS/OHPRD/JCM;COMMON DRUG PRINT[ 02/03/95 2:25 PM ]
- +1 ;;5.06;PS;;JUL 12, 1990
- +2 ;THIS ROUTINE PRINTS THE PHARMACY DRUG LISTING
- +3 ;IT IS CALLED BY AZFMCM
- +4 ;
- +5 ;INPUT VARIABLES: BD,ED,PSZCNT,^TMP("PSOZCOM2",$J)
- +6 ;VARIABLES: I,X,NUM,UTL,DRGNAME
- +7 ;
- +8 ;EXTERNAL CALLS: NOW^%DTC,^%ZIS
- +9 ;
- START ;INITIALIZE
- +1 SET (DX,DY)=1
- IF $DATA(^%ZOSF("XY"))#2
- XECUTE ^("XY")
- +2 USE IO
- +3 SET PSOZCOM1("PAGE")=0
- SET APSPO=""
- +4 DO HEADER
- +5 ;
- +6 ;START LOOP
- +7 ;F NUM=0:0 S NUM=$O(^TMP("PSOZCOM2",$J,NUM)) Q:NUM=""!(NUM>PSZCNT) D DRUG
- +8 DO DRUG
- +9 ;
- EXIT ;
- +1 IF $EXTRACT(IOST,1,2)="P-"
- WRITE !,@IOF
- +2 XECUTE ^%ZIS("C")
- +3 KILL NUM,DRGNAME,I,X,BD,ED,PSZCNT,UTL,PSOZCOM1,DX,DY
- +4 QUIT
- PRINT ;
- +1 IF $Y+4>IOSL
- WRITE @IOF
- DO HEADER
- +2 SET UTL=^TMP("PSOZCOM1",$JOB,DRGNAME,APSPO)
- +3 ;DRUG NAME
- WRITE !,DRGNAME
- +4 ;TOTAL FILLS
- WRITE ?40,$PIECE(UTL,U,3)
- +5 ;NEW RXS
- WRITE ?47,$PIECE(UTL,U,1)
- +6 ;REFILLS
- WRITE ?52,$PIECE(UTL,U,2)
- +7 WRITE ?60,APSPO,?70,$PIECE(UTL,U,4)
- +8 QUIT
- DRUG ;
- +1 SET DRGNAME=0
- +2 FOR I=0:0
- SET DRGNAME=$ORDER(^TMP("PSOZCOM1",$JOB,DRGNAME))
- IF DRGNAME=""
- QUIT
- FOR
- SET APSPO=$ORDER(^TMP("PSOZCOM1",$JOB,DRGNAME,APSPO))
- IF APSPO=""
- QUIT
- DO PRINT
- +3 QUIT
- +1 SET PSOZCOM1("PAGE")=PSOZCOM1("PAGE")+1
- +2 IF $DATA(DUZ(2))
- WRITE !!,$PIECE(^DIC(4,DUZ(2),0),"^",1)," DISPENSED DRUG LIST"
- +3 IF '$DATA(DUZ(2))
- WRITE !!,"DISPENSED DRUG LIST"
- +4 WRITE ?73,"Page ",PSOZCOM1("PAGE")
- +5 WRITE !,"DATE OF LISTING: "
- +6 DO NOW^%DTC
- WRITE $EXTRACT(X,4,5)_"-"_$EXTRACT(X,6,7)_"-"_$EXTRACT(X,2,3)
- +7 WRITE !!,"This list includes all prescriptions from "
- +8 WRITE $EXTRACT(BD,4,5)_"-"_$EXTRACT(BD,6,7)_"-"_$EXTRACT(BD,2,3)," through "
- +9 WRITE $EXTRACT(ED,4,5)_"-"_$EXTRACT(ED,6,7)_"-"_$EXTRACT(ED,2,3)_"."
- +10 ;W !,"The drug must have been issued a minimum of * "
- +11 ;W 9999999-PSZCNT," * times to appear on listing.",!!
- +12 WRITE !!,"DRUG",?40,"TOTAL",?47,"NEW",?52,"REFILL",?60,"DISPENSE",?70,"QTY",!,?60,"UNIT"
- +13 WRITE !
- FOR I=1:1:IOM
- WRITE "-"
- +14 ;I '$D(^TMP("PSOZCOM2",$J)) W !!?20,"NO RXS FOR A DRUG THAT TOTALS OVER COUNT SPECIFIED" ;G EXIT ;IHS/OHPRD/JCM 11/28/89
- +15 WRITE !
- +16 QUIT