PSGWNU1.m

PSGWNU1 ;BHAM ISC/PTD,CML-Print Drugs (Items) with NO Usage for Selected Date Range - CONTINUED ; 23 Mar 93 / 12:54 PM

 ;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94

PRINT ;PRINT ZERO USAGE REPORT FOR ALL DRUGS BY AOU

 S PGCT=1,(AOU,QFLG)="" D NOW^%DTC S CURDT=$P(%,".") I $O(^TMP("PSGWNU",$J,AOU))']"" D HDR W !,"NO ITEMS WITH ZERO USAGE FOR SELECTED DATE RANGE." G DONE

AOULP S AOU=$O(^TMP("PSGWNU",$J,AOU)) G:'AOU DONE D PRTCHK G:QFLG END W !,"==> ",$P(^PSI(58.1,AOU,0),"^") S DRG=0

DRLP S DRG=$O(^TMP("PSGWNU",$J,AOU,DRG)) D:DRG=""&($E(IOST)'="C") MSG G:DRG="" AOULP D:$Y+7>IOSL PRTCHK G:QFLG END

 S LOC=^TMP("PSGWNU",$J,AOU,DRG),AR=$P(LOC,"^"),OD=$P(LOC,"^",2),LSTDT=$S((AR'<OD):AR,(OD'<AR):OD,1:""),RET=$P(LOC,"^",3)

 W ! I LSTDT'="" S X1=CURDT,X2=LSTDT D ^%DTC S ASTER=X\90 S:ASTER<0 ASTER=0 I ASTER>0 F J=1:1:ASTER W "*"

 W ?8,DRG I LSTDT'="" S Y=LSTDT X ^DD("DD") W ?48,$P(Y,"@") W:RET="Y" ?64,"INCLUDES RETURNS" G DRLP

 I LSTDT="" W ?48,"NO DISPENSE DATES FOUND" G DRLP

 ;

DONE I $E(IOST)'="C" W @IOF

 I $E(IOST)="C" D:'QFLG SS^PSGWUTL1

END K ^TMP("PSGWNU",$J),AOU,ALL,BDT,DRG,DRGDA,DRGNAME,DRGNM,DRGQD,EDT,INVDA,INVDT,INVN,J,ODA,ODT,PGCT,QD,RETDT,AR,ARDT,LOC,LSTDT,OD,RET,RFLG,JJ,AOULP,ASTER,CURDT,PSGWIO,ZTSK,X,Y,ANS,QFLG

 K %,%I,%H,ZTIO,DA,G,SEL,IGDA,IO("Q") D ^%ZISC

 S:$D(ZTQUEUED) ZTREQ="@" Q

 ;

HDR ;PRINT REPORT HEADER

 W:$Y @IOF W !,"ITEMS WITH ZERO USAGE FROM " S Y=BDT X ^DD("DD") W Y," TO " S Y=EDT X ^DD("DD") W Y,?70,"PAGE ",PGCT I $D(SEL),SEL="I",$D(IGDA) W !,"FOR INVENTORY GROUP - ",$P(^PSI(58.2,IGDA,0),"^")

 W !!,"AREA OF USE",?55,"DATE: ",$$PSGWDT^PSGWUTL1

 W !?8,"NO USAGE FOR:",?45,"DATE LAST DISPENSED:",! S PGCT=PGCT+1 F J=1:1:80 W "-"

 Q

 ;

MSG W !!!,"For each ""*"" printed, 90 days have passed from",!,"the date item was last dispensed to current date."

 Q

PRTCHK ;

 I PGCT>1&($E(IOST)="C") D MSG W !!,"Press <RETURN> to Continue or ""^"" to Exit: " R ANS:DTIME S:'$T ANS="^" D:ANS?1."?" HELP^PSGWUTL1 I ANS="^" S QFLG=1 Q

 D HDR Q

PSGWNU1   ;BHAM ISC/PTD,CML-Print Drugs (Items) with NO Usage for Selected Date Range - CONTINUED ; 23 Mar 93 / 12:54 PM

 +1       ;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94

PRINT     ;PRINT ZERO USAGE REPORT FOR ALL DRUGS BY AOU

 +1        SET PGCT=1

           SET (AOU,QFLG)=""

           DO NOW^%DTC

           SET CURDT=$PIECE(%,".")

           IF $ORDER(^TMP("PSGWNU",$JOB,AOU))']""

               DO HDR

               WRITE !,"NO ITEMS WITH ZERO USAGE FOR SELECTED DATE RANGE."

               GOTO DONE

AOULP      SET AOU=$ORDER(^TMP("PSGWNU",$JOB,AOU))

           IF 'AOU

               GOTO DONE

           DO PRTCHK

           IF QFLG

               GOTO END

           WRITE !,"==> ",$PIECE(^PSI(58.1,AOU,0),"^")

           SET DRG=0

DRLP       SET DRG=$ORDER(^TMP("PSGWNU",$JOB,AOU,DRG))

           IF DRG=""&($EXTRACT(IOST)'="C")

               DO MSG

           IF DRG=""

               GOTO AOULP

           IF $Y+7>IOSL

               DO PRTCHK

           IF QFLG

               GOTO END

 +1        SET LOC=^TMP("PSGWNU",$JOB,AOU,DRG)

           SET AR=$PIECE(LOC,"^")

           SET OD=$PIECE(LOC,"^",2)

           SET LSTDT=$SELECT((AR'<OD):AR,(OD'<AR):OD,1:"")

           SET RET=$PIECE(LOC,"^",3)

 +2        WRITE !

           IF LSTDT'=""

               SET X1=CURDT

               SET X2=LSTDT

               DO ^%DTC

               SET ASTER=X\90

               IF ASTER<0

                   SET ASTER=0

               IF ASTER>0

                   FOR J=1:1:ASTER

                       WRITE "*"

 +3        WRITE ?8,DRG

           IF LSTDT'=""

               SET Y=LSTDT

               XECUTE ^DD("DD")

               WRITE ?48,$PIECE(Y,"@")

               IF RET="Y"

                   WRITE ?64,"INCLUDES RETURNS"

               GOTO DRLP

 +4        IF LSTDT=""

               WRITE ?48,"NO DISPENSE DATES FOUND"

               GOTO DRLP

 +5       ;

DONE       IF $EXTRACT(IOST)'="C"

               WRITE @IOF

 +1        IF $EXTRACT(IOST)="C"

               IF 'QFLG

                   DO SS^PSGWUTL1

END        KILL ^TMP("PSGWNU",$JOB),AOU,ALL,BDT,DRG,DRGDA,DRGNAME,DRGNM,DRGQD,EDT,INVDA,INVDT,INVN,J,ODA,ODT,PGCT,QD,RETDT,AR,ARDT,LOC,LSTDT,OD,RET,RFLG,JJ,AOULP,ASTER,CURDT,PSGWIO,ZTSK,X,Y,ANS,QFLG

 +1        KILL %,%I,%H,ZTIO,DA,G,SEL,IGDA,IO("Q")

           DO ^%ZISC

 +2        IF $DATA(ZTQUEUED)

               SET ZTREQ="@"

           QUIT 

 +3       ;

HDR       ;PRINT REPORT HEADER

 +1        IF $Y

               WRITE @IOF

           WRITE !,"ITEMS WITH ZERO USAGE FROM "

           SET Y=BDT

           XECUTE ^DD("DD")

           WRITE Y," TO "

           SET Y=EDT

           XECUTE ^DD("DD")

           WRITE Y,?70,"PAGE ",PGCT

           IF $DATA(SEL)

               IF SEL="I"

                   IF $DATA(IGDA)

                       WRITE !,"FOR INVENTORY GROUP - ",$PIECE(^PSI(58.2,IGDA,0),"^")

 +2        WRITE !!,"AREA OF USE",?55,"DATE: ",$$PSGWDT^PSGWUTL1

 +3        WRITE !?8,"NO USAGE FOR:",?45,"DATE LAST DISPENSED:",!

           SET PGCT=PGCT+1

           FOR J=1:1:80

               WRITE "-"

 +4        QUIT 

 +5       ;

MSG        WRITE !!!,"For each ""*"" printed, 90 days have passed from",!,"the date item was last dispensed to current date."

 +1        QUIT 

PRTCHK    ;

 +1        IF PGCT>1&($EXTRACT(IOST)="C")

               DO MSG

               WRITE !!,"Press <RETURN> to Continue or ""^"" to Exit: "

               READ ANS:DTIME

               IF '$TEST

                   SET ANS="^"

               IF ANS?1."?"

                   DO HELP^PSGWUTL1

               IF ANS="^"

                   SET QFLG=1

                   QUIT 

 +2        DO HDR

           QUIT