PSGWCCP.m

PSGWCCP ;BHAM ISC/CML-Print Crash Cart Location List ; 05/13/91 9:22

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

 W !!!,"This option will list crash carts and their locations.",!!,"Right margin for this report is 80 columns.",!,"You may queue the report to print at a later time.",!!

 I '$O(^PSI(58.1,0)) W *7,!!,"There are no AOUs defined!" Q

DEV K %ZIS,IOP S %ZIS="QM",%ZIS("B")="" D ^%ZIS I POP W !,"NO DEVICE SELECTED OR REPORT PRINTED!" G QUIT

 I $D(IO("Q")) K IO("Q") S PSGWIO=ION,ZTIO="" K ZTSAVE,ZTDTH,ZTSK S ZTRTN="ENQ^PSGWCCP",ZTDESC="Crash Cart Location List",ZTSAVE("PSGWIO")=""

 I  D ^%ZTLOAD,HOME^%ZIS K ZTSK G QUIT

 U IO

 ;

ENQ ;ENTRY POINT WHEN QUEUED

 K ^TMP("PSGWCCP",$J) F AOU=0:0 S AOU=$O(^PSI(58.1,AOU)) G:('AOU)&($D(ZTQUEUED)) PRTQUE G:'AOU PRINT I $D(^PSI(58.1,AOU,0)),$P(^(0),"^",5) D BUILD

 ;

BUILD ;BUILD DATA ELEMENTS

 S LOC=$P(^PSI(58.1,AOU,0),"^",6),AOUNM=$P(^(0),"^"),LOCNM="NONE LISTED" I LOC,$D(^SC(LOC,0)) S LOCNM=$P(^(0),"^")

 S ^TMP("PSGWCCP",$J,AOUNM)=LOCNM Q

PRTQUE ;AFTER DATA IS COMPILED, QUEUE THE PRINT

 K ZTSAVE,ZTIO S ZTIO=PSGWIO,ZTRTN="PRINT^PSGWCCP",ZTDESC="Print Crash Cart Location List",ZTDTH=$H,ZTSAVE("^TMP(""PSGWCCP"",$J,")=""

 D ^%ZTLOAD K ^TMP("PSGWCCP",$J) G QUIT

PRINT ;

 S $P(LN,"-",80)="",PG=0,%DT="",(AOUNM,QFLG)="",X="T" D ^%DT X ^DD("DD") S HDT=Y D HDR

 I '$D(^TMP("PSGWCCP",$J)) W !?17,"***** NO DATA AVAILABLE FOR THIS REPORT *****" S QFLG=1 G DONE

 F LL=0:0 S AOUNM=$O(^TMP("PSGWCCP",$J,AOUNM)) Q:AOUNM=""!(QFLG)  D:$Y+4>IOSL PRTCHK Q:QFLG  W !,AOUNM,?35,^(AOUNM)

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

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

QUIT ;

 K %DT,AOU,AOUNM,LOC,LOCNM,HDT,LL,LN,PG,PSGWDT,X,Y,PSGWIO,ZTSK,ZTIO,DA,IO("Q"),%,%I,%H,ANS,QFLG

 K ^TMP("PSGWCCP",$J) D ^%ZISC

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

HDR ;HEADER

 W:$Y @IOF S PG=PG+1 W !?28,"CRASH CART LOCATION LIST",?71,"PAGE: ",PG,!?30,"PRINTED: ",HDT,!!,"CRASH CART",?35,"LOCATION",!,LN

 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

PSGWCCP   ;BHAM ISC/CML-Print Crash Cart Location List ; 05/13/91 9:22

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

 +2        WRITE !!!,"This option will list crash carts and their locations.",!!,"Right margin for this report is 80 columns.",!,"You may queue the report to print at a later time.",!!

 +3        IF '$ORDER(^PSI(58.1,0))

               WRITE *7,!!,"There are no AOUs defined!"

               QUIT 

DEV        KILL %ZIS,IOP

           SET %ZIS="QM"

           SET %ZIS("B")=""

           DO ^%ZIS

           IF POP

               WRITE !,"NO DEVICE SELECTED OR REPORT PRINTED!"

               GOTO QUIT

 +1        IF $DATA(IO("Q"))

               KILL IO("Q")

               SET PSGWIO=ION

               SET ZTIO=""

               KILL ZTSAVE,ZTDTH,ZTSK

               SET ZTRTN="ENQ^PSGWCCP"

               SET ZTDESC="Crash Cart Location List"

               SET ZTSAVE("PSGWIO")=""

 +2       IF $TEST

               DO ^%ZTLOAD

               DO HOME^%ZIS

               KILL ZTSK

               GOTO QUIT

 +3        USE IO

 +4       ;

ENQ       ;ENTRY POINT WHEN QUEUED

 +1        KILL ^TMP("PSGWCCP",$JOB)

           FOR AOU=0:0

               SET AOU=$ORDER(^PSI(58.1,AOU))

               IF ('AOU)&($DATA(ZTQUEUED))

                   GOTO PRTQUE

               IF 'AOU

                   GOTO PRINT

               IF $DATA(^PSI(58.1,AOU,0))

                   IF $PIECE(^(0),"^",5)

                       DO BUILD

 +2       ;

BUILD     ;BUILD DATA ELEMENTS

 +1        SET LOC=$PIECE(^PSI(58.1,AOU,0),"^",6)

           SET AOUNM=$PIECE(^(0),"^")

           SET LOCNM="NONE LISTED"

           IF LOC

               IF $DATA(^SC(LOC,0))

                   SET LOCNM=$PIECE(^(0),"^")

 +2        SET ^TMP("PSGWCCP",$JOB,AOUNM)=LOCNM

           QUIT 

PRTQUE    ;AFTER DATA IS COMPILED, QUEUE THE PRINT

 +1        KILL ZTSAVE,ZTIO

           SET ZTIO=PSGWIO

           SET ZTRTN="PRINT^PSGWCCP"

           SET ZTDESC="Print Crash Cart Location List"

           SET ZTDTH=$HOROLOG

           SET ZTSAVE("^TMP(""PSGWCCP"",$J,")=""

 +2        DO ^%ZTLOAD

           KILL ^TMP("PSGWCCP",$JOB)

           GOTO QUIT

PRINT     ;

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

           SET PG=0

           SET %DT=""

           SET (AOUNM,QFLG)=""

           SET X="T"

           DO ^%DT

           XECUTE ^DD("DD")

           SET HDT=Y

           DO HDR

 +2        IF '$DATA(^TMP("PSGWCCP",$JOB))

               WRITE !?17,"***** NO DATA AVAILABLE FOR THIS REPORT *****"

               SET QFLG=1

               GOTO DONE

 +3        FOR LL=0:0

               SET AOUNM=$ORDER(^TMP("PSGWCCP",$JOB,AOUNM))

               IF AOUNM=""!(QFLG)

                   QUIT 

               IF $Y+4>IOSL

                   DO PRTCHK

               IF QFLG

                   QUIT 

               WRITE !,AOUNM,?35,^(AOUNM)

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

               WRITE @IOF

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

               IF 'QFLG

                   DO SS^PSGWUTL1

QUIT      ;

 +1        KILL %DT,AOU,AOUNM,LOC,LOCNM,HDT,LL,LN,PG,PSGWDT,X,Y,PSGWIO,ZTSK,ZTIO,DA,IO("Q"),%,%I,%H,ANS,QFLG

 +2        KILL ^TMP("PSGWCCP",$JOB)

           DO ^%ZISC

 +3        IF $DATA(ZTQUEUED)

               SET ZTREQ="@"

           QUIT 

HDR       ;HEADER

 +1        IF $Y

               WRITE @IOF

           SET PG=PG+1

           WRITE !?28,"CRASH CART LOCATION LIST",?71,"PAGE: ",PG,!?30,"PRINTED: ",HDT,!!,"CRASH CART",?35,"LOCATION",!,LN

 +2        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