AZFMCM1.m

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

HEADER ;

 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 

HEADER    ;

 +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