- 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
