PSGWSC1.m

PSGWSC1 ;BHAM ISC/PTD,CML-Print Cost Report for Single Item for Selected Date Range - CONTINUED ; 23 Mar 93 / 12:55 PM

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

EN1 S (QD,CST,INACTOT)=0,PGCT=1,QFLG="",$P(LN,"-",80)="" D HDR

AOU F AOU=0:0 S AOU=$O(^TMP("PSGWSC",$J,AOU)) Q:'AOU  D WRTLN G:QFLG END

 I '$O(^TMP("PSGWSC",$J,0)) W !?5,"NO COST DATA IN FILE FOR SELECTED DATES." G DONE

WRTOT W !?44 F J=1:1:31 W "-"

 W !?39,"TOTAL",?46,$J((QD),8,0),?64,$S(INACTOT=1:"INCOMPLETE",1:$J((CST),10,2)),!!

 ;

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

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

END K ZTSK,ALL,AOU,CST,BDT,DRGCST,DRGDA,DRGNM,DRGQD,EDT,INACTOT,INC,INVDA,INVDT,INVN,J,JJ,SEL,IGDA,LOC,LOC1,LOC2,ODA,ODT,PGCT,ITNAM,QD,RETDT,%,%I,%H,D,DA,G,^TMP("PSGWSC",$J),^TMP("PSGWINV",$J),IO("Q"),X,Y,ANS,QFLG,LN,JJ,CHK,AOUCNT,AOULP

 D ^%ZISC

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

 ;

HDR ;PRINT REPORT MAIN HEADER

 W:$Y @IOF W !?5,"COST REPORT 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 !?5,"FOR INVENTORY GROUP - ",$P(^PSI(58.2,IGDA,0),"^")

 W !?5,"DATE: ",$$PSGWDT^PSGWUTL1 S PGCT=PGCT+1 W !!?5,"ITEM: ",ITNAM,!?46,"QUANTITY",!?5,"AREA OF USE",?45,"DISPENSED",?67,"COST",!,LN

 Q

 ;

WRTLN S LOC=^TMP("PSGWSC",$J,AOU) D:$Y+5>IOSL PRTCHK Q:QFLG  W !?5,$P(^PSI(58.1,AOU,0),"^"),?46,$J($P(LOC,"^"),8,0),?64,$S($P(LOC,"^",2)'="NO DATA":$J($P(LOC,"^",2),10,2),1:"DATA MISSING")

 S QD=QD+$P(LOC,"^") I $P(LOC,"^",2)'="NO DATA" S CST=CST+$P(LOC,"^",2) Q

 E  S INACTOT=1 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

PSGWSC1   ;BHAM ISC/PTD,CML-Print Cost Report for Single Item for Selected Date Range - CONTINUED ; 23 Mar 93 / 12:55 PM

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

EN1        SET (QD,CST,INACTOT)=0

           SET PGCT=1

           SET QFLG=""

           SET $PIECE(LN,"-",80)=""

           DO HDR

AOU        FOR AOU=0:0

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

               IF 'AOU

                   QUIT 

               DO WRTLN

               IF QFLG

                   GOTO END

 +1        IF '$ORDER(^TMP("PSGWSC",$JOB,0))

               WRITE !?5,"NO COST DATA IN FILE FOR SELECTED DATES."

               GOTO DONE

WRTOT      WRITE !?44

           FOR J=1:1:31

               WRITE "-"

 +1        WRITE !?39,"TOTAL",?46,$JUSTIFY((QD),8,0),?64,$SELECT(INACTOT=1:"INCOMPLETE",1:$JUSTIFY((CST),10,2)),!!

 +2       ;

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

               WRITE @IOF

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

               IF 'QFLG

                   DO SS^PSGWUTL1

END        KILL ZTSK,ALL,AOU,CST,BDT,DRGCST,DRGDA,DRGNM,DRGQD,EDT,INACTOT,INC,INVDA,INVDT,INVN,J,JJ,SEL,IGDA,LOC,LOC1,LOC2,ODA,ODT,PGCT,ITNAM,QD,RETDT,%,%I,%H,D,DA,G,^TMP("PSGWSC",$JOB),^TMP("PSGWINV",$JOB),IO("Q"),X,Y,ANS,QFLG,LN,JJ,CHK,AOUCNT,AOULP

 +1        DO ^%ZISC

 +2        IF $DATA(ZTQUEUED)

               SET ZTREQ="@"

           QUIT 

 +3       ;

HDR       ;PRINT REPORT MAIN HEADER

 +1        IF $Y

               WRITE @IOF

           WRITE !?5,"COST REPORT 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 !?5,"FOR INVENTORY GROUP - ",$PIECE(^PSI(58.2,IGDA,0),"^")

 +2        WRITE !?5,"DATE: ",$$PSGWDT^PSGWUTL1

           SET PGCT=PGCT+1

           WRITE !!?5,"ITEM: ",ITNAM,!?46,"QUANTITY",!?5,"AREA OF USE",?45,"DISPENSED",?67,"COST",!,LN

 +3        QUIT 

 +4       ;

WRTLN      SET LOC=^TMP("PSGWSC",$JOB,AOU)

           IF $Y+5>IOSL

               DO PRTCHK

           IF QFLG

               QUIT 

           WRITE !?5,$PIECE(^PSI(58.1,AOU,0),"^"),?46,$JUSTIFY($PIECE(LOC,"^"),8,0),?64,$SELECT($PIECE(LOC,"^",2)'="NO DATA":$JUSTIFY($PIECE(LOC,"^",2),10,2),1:"DATA MISSING")

 +1        SET QD=QD+$PIECE(LOC,"^")

           IF $PIECE(LOC,"^",2)'="NO DATA"

               SET CST=CST+$PIECE(LOC,"^",2)

               QUIT 

 +2       IF '$TEST

               SET INACTOT=1

               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