- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSGWNU1 2004 printed Jan 18, 2025@02:40:51 Page 2
- 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