- PSGWHC1 ;BHAM ISC/PTD,CML-Print High Cost Report for Selected Date Range - CONTINUED ; 23 Mar 93 / 12:53 PM
- ;;2.3;Automatic Replenishment/Ward Stock ;**21**;4 JAN 94;Build 6
- EN1 S (UT1,UT2,CNT)=0,PGCT=1,QFLG="" D HDR I '$D(^TMP("PSGWHC",$J,"HI")) W !!,"NO DATA AVAILABLE FOR SELECTED DATES." G DONE
- UT1LP S UT1=$O(^TMP("PSGWHC",$J,"HI",UT1)) I UT1="" W !!,"# of Items: ",CNT G DONE
- UT2LP S UT2=$O(^TMP("PSGWHC",$J,"HI",UT1,UT2)) G:UT2="" UT1LP S LOC=^TMP("PSGWHC",$J,"HI",UT1,UT2),DRG=$S(SORT=2:UT1,1:UT2)
- D:$Y+4>IOSL PRTCHK G:QFLG END W !,DRG,?44,$S($P(LOC,"^")'="NO DATA":$J($P(LOC,"^"),10,2),1:"COST DATA MISSING"),?64,$J($P(LOC,"^",2),8,0) S CNT=CNT+1 G UT2LP
- ;
- DONE I $E(IOST)'="C" W @IOF
- I $E(IOST)="C" D:'QFLG SS^PSGWUTL1
- ;PSGW*2.3*21 add PSGWCNM to kill list
- END K PSGWCNM,ALL,AOU,AOUCST,AOUQD,BDT,DRG,DRGCST,DRGDA,DRGNAME,DRGNM,DRGQD,EDT,INACTOT,INC,INVDA,INVDT,INVN,J,LOC,LOC1,LOC2,LOCSR,LOCWD,ODA,ODT,PGCT,PRCNT,PRCT,QD,RETDT,SORT,SRV,SRVDA,UT1,UT2,WARD,WDN,WRDA,WRDDA,ZTSK,X
- K ANS,QFLG,AOUN,CF,CNT,CST,CUT,DRN,DRUG,LOCN,QUAN,TOTCST,TOTQD,PSGWIO,PSGWION,%,%I,%H,G,ZTIO,^TMP("PSGWHC",$J),ZTSK,IO("Q") D ^%ZISC
- S:$D(ZTQUEUED) ZTREQ="@" Q
- ;
- HDR ;PRINT REPORT MAIN HEADER
- W:$Y @IOF W !,"HIGH COST REPORT AR/WS - ",$S(ALL=1:"FOR ALL AOUS",1:$P(^PSI(58.1,AOU,0),"^")),?70,"PAGE ",PGCT,!,"TOTAL COST GREATER THAN OR EQUAL TO $",CUT
- W !,"FROM " S Y=BDT X ^DD("DD") W Y," TO " S Y=EDT X ^DD("DD") W Y
- W !!?53,"DATE: ",$$PSGWDT^PSGWUTL1 S PGCT=PGCT+1
- W !?5,"ITEM",?45,"TOTAL COST",?60,"QUANTITY DISPENSED",! F J=1:1:80 W "-"
- Q
- PRTCHK ;
- I $E(IOST)="C" 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[HPSGWHC1 1724 printed Jan 18, 2025@02:40:40 Page 2
- PSGWHC1 ;BHAM ISC/PTD,CML-Print High Cost Report for Selected Date Range - CONTINUED ; 23 Mar 93 / 12:53 PM
- +1 ;;2.3;Automatic Replenishment/Ward Stock ;**21**;4 JAN 94;Build 6
- EN1 SET (UT1,UT2,CNT)=0
- SET PGCT=1
- SET QFLG=""
- DO HDR
- IF '$DATA(^TMP("PSGWHC",$JOB,"HI"))
- WRITE !!,"NO DATA AVAILABLE FOR SELECTED DATES."
- GOTO DONE
- UT1LP SET UT1=$ORDER(^TMP("PSGWHC",$JOB,"HI",UT1))
- IF UT1=""
- WRITE !!,"# of Items: ",CNT
- GOTO DONE
- UT2LP SET UT2=$ORDER(^TMP("PSGWHC",$JOB,"HI",UT1,UT2))
- if UT2=""
- GOTO UT1LP
- SET LOC=^TMP("PSGWHC",$JOB,"HI",UT1,UT2)
- SET DRG=$SELECT(SORT=2:UT1,1:UT2)
- +1 if $Y+4>IOSL
- DO PRTCHK
- if QFLG
- GOTO END
- WRITE !,DRG,?44,$SELECT($PIECE(LOC,"^")'="NO DATA":$JUSTIFY($PIECE(LOC,"^"),10,2),1:"COST DATA MISSING"),?64,$JUSTIFY($PIECE(LOC,"^",2),8,0)
- SET CNT=CNT+1
- GOTO UT2LP
- +2 ;
- DONE IF $EXTRACT(IOST)'="C"
- WRITE @IOF
- +1 IF $EXTRACT(IOST)="C"
- if 'QFLG
- DO SS^PSGWUTL1
- +2 ;PSGW*2.3*21 add PSGWCNM to kill list
- END KILL PSGWCNM,ALL,AOU,AOUCST,AOUQD,BDT,DRG,DRGCST,DRGDA,DRGNAME,DRGNM,DRGQD,EDT,INACTOT,INC,INVDA,INVDT,INVN,J,LOC,LOC1,LOC2,LOCSR,LOCWD,ODA,ODT,PGCT,PRCNT,PRCT,QD,RETDT,SORT,SRV,SRVDA,UT1,UT2,WARD,WDN,WRDA,WRDDA,ZTSK,X
- +1 KILL ANS,QFLG,AOUN,CF,CNT,CST,CUT,DRN,DRUG,LOCN,QUAN,TOTCST,TOTQD,PSGWIO,PSGWION,%,%I,%H,G,ZTIO,^TMP("PSGWHC",$JOB),ZTSK,IO("Q")
- DO ^%ZISC
- +2 if $DATA(ZTQUEUED)
- SET ZTREQ="@"
- QUIT
- +3 ;
- HDR ;PRINT REPORT MAIN HEADER
- +1 if $Y
- WRITE @IOF
- WRITE !,"HIGH COST REPORT AR/WS - ",$SELECT(ALL=1:"FOR ALL AOUS",1:$PIECE(^PSI(58.1,AOU,0),"^")),?70,"PAGE ",PGCT,!,"TOTAL COST GREATER THAN OR EQUAL TO $",CUT
- +2 WRITE !,"FROM "
- SET Y=BDT
- XECUTE ^DD("DD")
- WRITE Y," TO "
- SET Y=EDT
- XECUTE ^DD("DD")
- WRITE Y
- +3 WRITE !!?53,"DATE: ",$$PSGWDT^PSGWUTL1
- SET PGCT=PGCT+1
- +4 WRITE !?5,"ITEM",?45,"TOTAL COST",?60,"QUANTITY DISPENSED",!
- FOR J=1:1:80
- WRITE "-"
- +5 QUIT
- PRTCHK ;
- +1 IF $EXTRACT(IOST)="C"
- 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