ASMSOFT.m

ASMSOFT ;PRINT SOFTWARE CHANGE BULLETIN [ 10/02/85  12:47 PM ]

 ;IHS-OKLA CITY AREA OFFICE-LMD

L1 D ^AUCLS W !!,"SOFTWARE BULLETIN PRINTER......",!! S ASM("PG")=0

L2 S DIC="^AZOSOFT(",DIC(0)="QAZEM" D ^DIC Q:+Y<0  S ASM("SYS")=+Y

L3 W ! S %DT="AEPT" D ^%DT G L1:Y<0 S X=Y

L4 I '$D(^AZOSOFT("C",X,ASM("SYS"))) W *7 G L3

L5 S ASM("DT")=$O(^AZOSOFT("C",Y,ASM("SYS"),0))

L6 G QUE

START S (PG,ASM("PG"))=0 U IO D L7 G CHNG

L7 W @IOF,"Software change bulletin.....",?65,"page ",PG+1,!!!,"SOFTWARE SYSTEM: ",^AZOSOFT(ASM("SYS"),0),!!,"Change number: ",^AZOSOFT(ASM("SYS"),1,ASM("DT"),2),!!,"Change date: "

 S Y=^AZOSOFT(ASM("SYS"),1,ASM("DT"),0) X ^DD("DD") W Y,!!,"SOURCE: ",^DD("SITE"),!! S AG("LINE")="=" D LINE Q

CHNG S ASM("PG")=$O(^AZOSOFT(ASM("SYS"),1,ASM("DT"),1,ASM("PG"))) G END:ASM("PG")="" K ^UTILITY($J,"W")

 S X=^AZOSOFT(ASM("SYS"),1,ASM("DT"),1,ASM("PG"),0) W "ROUTINE: ",$P(X,"^",1),!,?3,"LINE: ",$P(X,"^",2),!! D CHNG1 G CHNG

CHNG1 G CHNG3:'$D(^AZOSOFT(ASM("SYS"),1,ASM("DT"),1,ASM("PG"),1)) S I=0

CHNG1A S I=$O(^AZOSOFT(ASM("SYS"),1,ASM("DT"),1,ASM("PG"),1,I)) G CHNG2:I="" S X=^AZOSOFT(ASM("SYS"),1,ASM("DT"),1,ASM("PG"),1,I,0),DIWF="W",DIWL=1,DIWR=70 D ^DIWP G CHNG1A

CHNG2 D ^DIWW

CHNG3 G CHNG5:'$D(^AZOSOFT(ASM("SYS"),1,ASM("DT"),1,ASM("PG"),2)) W !!,"PROBLEM",!,"-------",! K ^UTILITY($J,"W") S I=0

CHNG3A S I=$O(^AZOSOFT(ASM("SYS"),1,ASM("DT"),1,ASM("PG"),2,I)) G CHNG3B:I="" S X=^AZOSOFT(ASM("SYS"),1,ASM("DT"),1,ASM("PG"),2,I,0),DIWL=5 D ^DIWP G CHNG3A

CHNG3B D ^DIWW

CHNG5 G CHNGEND:'$D(^AZOSOFT(ASM("SYS"),1,ASM("DT"),1,ASM("PG"),3)) W !!,"SOLUTION",!,"--------",! K ^UTILITY($J,"W") S I=0

CHNG5A S I=$O(^AZOSOFT(ASM("SYS"),1,ASM("DT"),1,ASM("PG"),3,I)) G CHNG5B:I="" S X=^AZOSOFT(ASM("SYS"),1,ASM("DT"),1,ASM("PG"),3,I,0) D ^DIWP G CHNG5A

CHNG5B D ^DIWW

CHNGEND D LINE I $Y>40 S PG=PG+1 D L7

 Q

END W @IOF X ^%ZIS("C") G ASMSOFT:$D(AU("PRINT")) K AU,ASM Q

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

PRQ S ASM("SYS")=^%ZTSK(ZTSK,"SYS"),ASM("DT")=^("DT")

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

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

QUE1 S ^%ZTSK(ZTSK,0)="PRQ^ASMSOFT"_^%ZTSK(ZTSK,0),^("SYS")=ASM("SYS"),^("DT")=ASM("DT")

QUEND K ZTSK G ASMSOFT

ASMSOFT   ;PRINT SOFTWARE CHANGE BULLETIN [ 10/02/85  12:47 PM ]

 +1       ;IHS-OKLA CITY AREA OFFICE-LMD

L1         DO ^AUCLS

           WRITE !!,"SOFTWARE BULLETIN PRINTER......",!!

           SET ASM("PG")=0

L2         SET DIC="^AZOSOFT("

           SET DIC(0)="QAZEM"

           DO ^DIC

           IF +Y<0

               QUIT 

           SET ASM("SYS")=+Y

L3         WRITE !

           SET %DT="AEPT"

           DO ^%DT

           IF Y<0

               GOTO L1

           SET X=Y

L4         IF '$DATA(^AZOSOFT("C",X,ASM("SYS")))

               WRITE *7

               GOTO L3

L5         SET ASM("DT")=$ORDER(^AZOSOFT("C",Y,ASM("SYS"),0))

L6         GOTO QUE

START      SET (PG,ASM("PG"))=0

           USE IO

           DO L7

           GOTO CHNG

L7         WRITE @IOF,"Software change bulletin.....",?65,"page ",PG+1,!!!,"SOFTWARE SYSTEM: ",^AZOSOFT(ASM("SYS"),0),!!,"Change number: ",^AZOSOFT(ASM("SYS"),1,ASM("DT"),2),!!,"Change date: "

 +1        SET Y=^AZOSOFT(ASM("SYS"),1,ASM("DT"),0)

           XECUTE ^DD("DD")

           WRITE Y,!!,"SOURCE: ",^DD("SITE"),!!

           SET AG("LINE")="="

           DO LINE

           QUIT 

CHNG       SET ASM("PG")=$ORDER(^AZOSOFT(ASM("SYS"),1,ASM("DT"),1,ASM("PG")))

           IF ASM("PG")=""

               GOTO END

           KILL ^UTILITY($JOB,"W")

 +1        SET X=^AZOSOFT(ASM("SYS"),1,ASM("DT"),1,ASM("PG"),0)

           WRITE "ROUTINE: ",$PIECE(X,"^",1),!,?3,"LINE: ",$PIECE(X,"^",2),!!

           DO CHNG1

           GOTO CHNG

CHNG1      IF '$DATA(^AZOSOFT(ASM("SYS"),1,ASM("DT"),1,ASM("PG"),1))

               GOTO CHNG3

           SET I=0

CHNG1A     SET I=$ORDER(^AZOSOFT(ASM("SYS"),1,ASM("DT"),1,ASM("PG"),1,I))

           IF I=""

               GOTO CHNG2

           SET X=^AZOSOFT(ASM("SYS"),1,ASM("DT"),1,ASM("PG"),1,I,0)

           SET DIWF="W"

           SET DIWL=1

           SET DIWR=70

           DO ^DIWP

           GOTO CHNG1A

CHNG2      DO ^DIWW

CHNG3      IF '$DATA(^AZOSOFT(ASM("SYS"),1,ASM("DT"),1,ASM("PG"),2))

               GOTO CHNG5

           WRITE !!,"PROBLEM",!,"-------",!

           KILL ^UTILITY($JOB,"W")

           SET I=0

CHNG3A     SET I=$ORDER(^AZOSOFT(ASM("SYS"),1,ASM("DT"),1,ASM("PG"),2,I))

           IF I=""

               GOTO CHNG3B

           SET X=^AZOSOFT(ASM("SYS"),1,ASM("DT"),1,ASM("PG"),2,I,0)

           SET DIWL=5

           DO ^DIWP

           GOTO CHNG3A

CHNG3B     DO ^DIWW

CHNG5      IF '$DATA(^AZOSOFT(ASM("SYS"),1,ASM("DT"),1,ASM("PG"),3))

               GOTO CHNGEND

           WRITE !!,"SOLUTION",!,"--------",!

           KILL ^UTILITY($JOB,"W")

           SET I=0

CHNG5A     SET I=$ORDER(^AZOSOFT(ASM("SYS"),1,ASM("DT"),1,ASM("PG"),3,I))

           IF I=""

               GOTO CHNG5B

           SET X=^AZOSOFT(ASM("SYS"),1,ASM("DT"),1,ASM("PG"),3,I,0)

           DO ^DIWP

           GOTO CHNG5A

CHNG5B     DO ^DIWW

CHNGEND    DO LINE

           IF $Y>40

               SET PG=PG+1

               DO L7

 +1        QUIT 

END        WRITE @IOF

           XECUTE ^%ZIS("C")

           IF $DATA(AU("PRINT"))

               GOTO ASMSOFT

           KILL AU,ASM

           QUIT 

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

               SET AG("OLD")=""

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

               SET AG("PRL")=""

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

               SET AG("OLD")=AG("LINE")

           WRITE !,AG("PRL"),!

           QUIT 

PRQ        SET ASM("SYS")=^%ZTSK(ZTSK,"SYS")

           SET ASM("DT")=^("DT")

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

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

           SET U="^"

           KILL ^%ZTSK(ZTSK)

           GOTO START

QUE        DO ^%AUQUE

           IF $DATA(AU("PRINT"))

               GOTO START

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

               QUIT 

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

           SET ^("SYS")=ASM("SYS")

           SET ^("DT")=ASM("DT")

QUEND      KILL ZTSK

           GOTO ASMSOFT