ASMWKSHT.m

ASMWKSHT ;PRINT A WORK-SHEET FOR FACILITY MODIFICATIONS [ 09/20/85  3:34 PM ]

 ;IHS-OKLA CITY AREA OFFICE-LMD

A1 D ^AUCLS W "FACILITY MODIFICATION WORKSHEET.......",!!! S DIC="^ASMMOD(",DIC(0)="QAZEM" D ^DIC Q:Y<1  S AU("MODPTR")=+Y,AU("MOD")=Y(0) G QUE

START U IO S PG=0,SITE="",AU("LINE")="=",AU("ULINE")="___________" D HEADING

L1 S SITE=$O(^ASMEQP("B",SITE)) G END:SITE="" S SITEDFN=$O(^ASMEQP("B",SITE,0)) G L1:'$D(^ASMEQP(SITEDFN,7)) S DAA=0

L2 K AU("MODFOUND") S DIC=1800002.07,DA=SITEDFN,DR=.01 F AU=1:1 S DAA=$O(^ASMEQP(DA,7,DAA)) Q:DAA=""  S LKDATA=$P(^ASMEQP(DA,7,DAA,0),"^",1)  I LKDATA=AU("MODPTR") S AU("MODFOUND")="" Q

L3 G L1:'$D(AU("MODFOUND")) W ?5,$P(^AUTTLOC(SITE,0),U,1),?50 S DRENT=DAA,DR=1 D ^AUDICLK W $S(LKPRINT="":AU("ULINE"),1:LKPRINT),! D HEADING:$Y>50 G L1

END K AU W @IOF C IO Q

SBRS K DFOUT,DTOUT,DUOUT,DQOUT,DLOUT R Y:USTO I '$T W *7 R Y:5 G SBRS:Y="." I '$T S (DTOUT,Y)="" Q

 S:Y="/.," (DFOUT,Y)="" S:Y="" DLOUT="" S:Y="^" (DUOUT,Y)="" S:Y?1"?".E!(Y["^") (DQOUT,Y)=""

 Q

YN W !!,"Enter a ""Y"" for YES or an ""N"" for NO." H 2 Q

LINE S:'$D(AU("PRL")) AU("OLD")="" S:AU("OLD")'=AU("LINE") AU("PRL")="",$P(AU("PRL"),AU("LINE"),79)="",AU("OLD")=AU("LINE") W !,AU("PRL"),! Q

HEADING S PG=PG+1,TITLE="FACILITY MODIFICATION WORKSHEET",TM=$P($H,",",2),HR=TM\3600,MIN=TM#3600\60 S:MIN<10 MIN="0"_MIN S TME=HR_":"_MIN,USER=""

 W #,!!,TME,?80-$L(TITLE)\2,TITLE,?72,"page ",PG,!,?80-$L(^DD("SITE"))\2,^DD("SITE"),!

UCI X ^%ZOSF("UCI") S MG("UCI")="UCI: "_$P(Y,",",1) W ?80-$L(MG("UCI"))\2,MG("UCI")

 I '$D(DT) S %DT="",X="T" D ^%DT S DT=Y

 S Y=DT X ^DD("DD") W !!,?80-$L("as of "_Y)\2,"as of ",Y,!!

 W !!,?5,"MODIFICATION:  ",AU("MOD"),!!,?10,"FACILITY",?50,"DATE COMPLETED" D LINE

 W ! Q

PRQ S AU("MODPTR")=^%ZTSK(ZTSK,"MODPTR"),AU("MOD")=^%ZTSK(ZTSK,"MOD")

PRQ1 S:$D(^%ZTSK(ZTSK,"SITE")) SITENUM=^%ZTSK(ZTSK,"SITE") S U="^" K ^%ZTSK(ZTSK) G START

QUE S IOP="Q" D ^%AUQUE G START:$D(AU("PRINT")) Q:'$D(AU("QUE"))

QUE1 S ^%ZTSK(ZTSK,0)="PRQ^ASMWKSHT"_^%ZTSK(ZTSK,0),^("MODPTR")=AU("MODPTR"),^("MOD")=AU("MOD")

QUEND K ZTSK Q

ASMWKSHT  ;PRINT A WORK-SHEET FOR FACILITY MODIFICATIONS [ 09/20/85  3:34 PM ]

 +1       ;IHS-OKLA CITY AREA OFFICE-LMD

A1         DO ^AUCLS

           WRITE "FACILITY MODIFICATION WORKSHEET.......",!!!

           SET DIC="^ASMMOD("

           SET DIC(0)="QAZEM"

           DO ^DIC

           IF Y<1

               QUIT 

           SET AU("MODPTR")=+Y

           SET AU("MOD")=Y(0)

           GOTO QUE

START      USE IO

           SET PG=0

           SET SITE=""

           SET AU("LINE")="="

           SET AU("ULINE")="___________"

           DO HEADING

L1         SET SITE=$ORDER(^ASMEQP("B",SITE))

           IF SITE=""

               GOTO END

           SET SITEDFN=$ORDER(^ASMEQP("B",SITE,0))

           IF '$DATA(^ASMEQP(SITEDFN,7))

               GOTO L1

           SET DAA=0

L2         KILL AU("MODFOUND")

           SET DIC=1800002.07

           SET DA=SITEDFN

           SET DR=.01

           FOR AU=1:1

               SET DAA=$ORDER(^ASMEQP(DA,7,DAA))

               IF DAA=""

                   QUIT 

               SET LKDATA=$PIECE(^ASMEQP(DA,7,DAA,0),"^",1)

               IF LKDATA=AU("MODPTR")

                   SET AU("MODFOUND")=""

                   QUIT 

L3         IF '$DATA(AU("MODFOUND"))

               GOTO L1

           WRITE ?5,$PIECE(^AUTTLOC(SITE,0),U,1),?50

           SET DRENT=DAA

           SET DR=1

           DO ^AUDICLK

           WRITE $SELECT(LKPRINT="":AU("ULINE"),1:LKPRINT),!

           IF $Y>50

               DO HEADING

           GOTO L1

END        KILL AU

           WRITE @IOF

           CLOSE IO

           QUIT 

SBRS       KILL DFOUT,DTOUT,DUOUT,DQOUT,DLOUT

           READ Y:USTO

           IF '$TEST

               WRITE *7

               READ Y:5

               IF Y="."

                   GOTO SBRS

               IF '$TEST

                   SET (DTOUT,Y)=""

                   QUIT 

 +1        IF Y="/.,"

               SET (DFOUT,Y)=""

           IF Y=""

               SET DLOUT=""

           IF Y="^"

               SET (DUOUT,Y)=""

           IF Y?1"?".E!(Y["^")

               SET (DQOUT,Y)=""

 +2        QUIT 

YN         WRITE !!,"Enter a ""Y"" for YES or an ""N"" for NO."

           HANG 2

           QUIT 

LINE       IF '$DATA(AU("PRL"))

               SET AU("OLD")=""

           IF AU("OLD")'=AU("LINE")

               SET AU("PRL")=""

               SET $PIECE(AU("PRL"),AU("LINE"),79)=""

               SET AU("OLD")=AU("LINE")

           WRITE !,AU("PRL"),!

           QUIT 

HEADING    SET PG=PG+1

           SET TITLE="FACILITY MODIFICATION WORKSHEET"

           SET TM=$PIECE($HOROLOG,",",2)

           SET HR=TM\3600

           SET MIN=TM#3600\60

           IF MIN<10

               SET MIN="0"_MIN

           SET TME=HR_":"_MIN

           SET USER=""

 +1        WRITE #,!!,TME,?80-$LENGTH(TITLE)\2,TITLE,?72,"page ",PG,!,?80-$LENGTH(^DD("SITE"))\2,^DD("SITE"),!

UCI        XECUTE ^%ZOSF("UCI")

           SET MG("UCI")="UCI: "_$PIECE(Y,",",1)

           WRITE ?80-$LENGTH(MG("UCI"))\2,MG("UCI")

 +1        IF '$DATA(DT)

               SET %DT=""

               SET X="T"

               DO ^%DT

               SET DT=Y

 +2        SET Y=DT

           XECUTE ^DD("DD")

           WRITE !!,?80-$LENGTH("as of "_Y)\2,"as of ",Y,!!

 +3        WRITE !!,?5,"MODIFICATION:  ",AU("MOD"),!!,?10,"FACILITY",?50,"DATE COMPLETED"

           DO LINE

 +4        WRITE !

           QUIT 

PRQ        SET AU("MODPTR")=^%ZTSK(ZTSK,"MODPTR")

           SET AU("MOD")=^%ZTSK(ZTSK,"MOD")

PRQ1       IF $DATA(^%ZTSK(ZTSK,"SITE"))

               SET SITENUM=^%ZTSK(ZTSK,"SITE")

           SET U="^"

           KILL ^%ZTSK(ZTSK)

           GOTO START

QUE        SET IOP="Q"

           DO ^%AUQUE

           IF $DATA(AU("PRINT"))

               GOTO START

           IF '$DATA(AU("QUE"))

               QUIT 

QUE1       SET ^%ZTSK(ZTSK,0)="PRQ^ASMWKSHT"_^%ZTSK(ZTSK,0)

           SET ^("MODPTR")=AU("MODPTR")

           SET ^("MOD")=AU("MOD")

QUEND      KILL ZTSK

           QUIT