Routine: DVBAPWKS

DVBAPWKS ;ALB/CMM AMIE EXAM FILE UPDATE ;1/20/94

 ;;2.7;AMIE;;Apr 10, 1995

EN ;

 N WKSCNT

 S WKSCNT=0

 D SET

 D LOOP

 D SG1

 D EXIT

SET N VAR

 S VAR=" - Adding to AMIE Exam File"

 W !!!,VAR

 D BUMPBLK^DVBAPOST

 D BUMPBLK^DVBAPOST

 D BUMPBLK^DVBAPOST

 D BUMP^DVBAPOST(VAR)

 D BUMPBLK^DVBAPOST

SET1 ;

 S DIF="^TMP($J,""DVBA"",",XCNP=0

 K ^TMP($J,"DVBA")

 F ROU="DVBAPW1","DVBAPW2" S X=ROU X ^%ZOSF("LOAD") W "."

 K DIF,XCNP,ROU

LOOP ;

 N LP,EXM,WKS

 S LP=0

 F  S LP=$O(^TMP($J,"DVBA",LP)) Q:(LP="")  D

 .K STOP

 .S LINE=^TMP($J,"DVBA",LP,0)

 .I (LINE'[";;")!(LINE[";AMIE;")!(LINE="") Q

 .S EXM=$P(LINE,";",3)

 .S WKS=$P(LINE,";",4)

 .D CHK

 .I $D(STOP) D SE Q

 .;;;D ADDW

 .D ADDE

 .W:(LP#10) "."

ADDW ;

 S DIE="^DVB(396.6,",DA=EXAM,DR=".07///"_WKS

 D ^DIE

 K DIW,DA,DR,DIE

ADDE ;

 I '$D(^DVB(396.6,EXAM,1,0)) S ^DVB(396.6,EXAM,1,0)="^396.61P^0^0"

 F LP1=5:1:999 S X=$P(LINE,";",LP1) Q:X=""  D

 .K STOP,DA

 .D SETUP

 .I $D(STOP) Q

 .S DLAYGO=396

 .K DD,DO

 .S DIC="^DVB(396.6,"_EXAM_",1,",DA(1)=EXAM,DIC(0)="LZM" D FILE^DICN

 .K DD,DO

 .I Y<0 D SE1

 .K DA,DIC,DLAYGO

 .I Y>0 S WKSCNT=WKSCNT+1

SE ;

 N VAR

 S VAR="Could not find AMIE Exam "_EXM

 W !!,VAR

 D BUMP^DVBAPOST(VAR)

SE1 ;

 N VAR

 S VAR="Addition of exam "_X_" to "_EXM_" has failed."

 W !!,VAR

 D BUMP^DVBAPOST(VAR)

CHK ;

 S DIC="^DVB(396.6,",DIC(0)="OZ",X=EXM,D="B"

 ;LOOKUP ONLY ON "B" CROSS REFERENCE

 D IX^DIC

 I Y<0 S STOP=1

 K DIC,X,D

 S EXAM=+Y

SG1 ;writes and updates the tmp global with the finish

 N LP1,V1

 F LP1=1:1:2 D BUMPBLK^DVBAPOST

 S V1="I have updated "_WKSCNT_" exams to the AMIE Exam file."

 W !!,V1

 D BUMP^DVBAPOST(V1)

 D BUMPBLK^DVBAPOST

EXIT ;

 K X,Y,STOP,EXAM,LINE,^TMP($J,"DVBA"),DVBAVAR

SETUP ;

 S DVBAVAR=$O(^DIC(31,"C",X,""))

 I DVBAVAR="" D SE3 S STOP=1 Q

 I '$D(^DIC(31,DVBAVAR,0)) D SE2 S STOP=1 Q

 I $O(^DVB(396.6,EXAM,1,"B",DVBAVAR,""))'="" S STOP=1 Q

 S X=DVBAVAR

SE2 ;

 N VAR

 S VAR="Zero node of the "_X_" code does not exist, AMIE Exam "_EXM_".  Please investigate!"

 W !!,VAR

 D BUMP^DVBAPOST(VAR)

SE3 ;

 N VAR

 S VAR="'C' cross reference for code "_X_" does not exist, AMIE Exam "_EXM_".  Please investigate!"

 W !!,VAR

 D BUMP^DVBAPOST(VAR)

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBAPWKS   2308     printed  Feb 18, 2025@23:08:20                                                                                                                                                                                                    Page 2

DVBAPWKS  ;ALB/CMM AMIE EXAM FILE UPDATE ;1/20/94

 +1       ;;2.7;AMIE;;Apr 10, 1995

 +2       ;

EN        ;

 +1        NEW WKSCNT

 +2        SET WKSCNT=0

 +3        DO SET

 +4        DO LOOP

 +5        DO SG1

 +6        DO EXIT

 +7        QUIT

SET        NEW VAR

 +1        SET VAR=" - Adding to AMIE Exam File"

 +2        WRITE !!!,VAR

 +3        DO BUMPBLK^DVBAPOST

 +4        DO BUMPBLK^DVBAPOST

 +5        DO BUMPBLK^DVBAPOST

 +6        DO BUMP^DVBAPOST(VAR)

 +7        DO BUMPBLK^DVBAPOST

SET1      ;

 +1        SET DIF="^TMP($J,""DVBA"","

           SET XCNP=0

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

 +3        FOR ROU="DVBAPW1","DVBAPW2"

               SET X=ROU

               XECUTE ^%ZOSF("LOAD")

               WRITE "."

 +4        KILL DIF,XCNP,ROU

 +5        QUIT

LOOP      ;

 +1        NEW LP,EXM,WKS

 +2        SET LP=0

 +3        FOR

               SET LP=$ORDER(^TMP($JOB,"DVBA",LP))

               if (LP="")

                   QUIT

               Begin DoDot:1

 +4                KILL STOP

 +5                SET LINE=^TMP($JOB,"DVBA",LP,0)

 +6                IF (LINE'[";;")!(LINE[";AMIE;")!(LINE="")

                       QUIT

 +7                SET EXM=$PIECE(LINE,";",3)

 +8                SET WKS=$PIECE(LINE,";",4)

 +9                DO CHK

 +10               IF $DATA(STOP)

                       DO SE

                       QUIT

 +11      ;;;D ADDW

 +12               DO ADDE

 +13               if (LP#10)

                       WRITE "."

               End DoDot:1

 +14       QUIT

ADDW      ;

 +1        SET DIE="^DVB(396.6,"

           SET DA=EXAM

           SET DR=".07///"_WKS

 +2        DO ^DIE

 +3        KILL DIW,DA,DR,DIE

 +4        QUIT

ADDE      ;

 +1        IF '$DATA(^DVB(396.6,EXAM,1,0))

               SET ^DVB(396.6,EXAM,1,0)="^396.61P^0^0"

 +2        FOR LP1=5:1:999

               SET X=$PIECE(LINE,";",LP1)

               if X=""

                   QUIT

               Begin DoDot:1

 +3                KILL STOP,DA

 +4                DO SETUP

 +5                IF $DATA(STOP)

                       QUIT

 +6                SET DLAYGO=396

 +7                KILL DD,DO

 +8                SET DIC="^DVB(396.6,"_EXAM_",1,"

                   SET DA(1)=EXAM

                   SET DIC(0)="LZM"

                   DO FILE^DICN

 +9                KILL DD,DO

 +10               IF Y<0

                       DO SE1

 +11               KILL DA,DIC,DLAYGO

 +12               IF Y>0

                       SET WKSCNT=WKSCNT+1

               End DoDot:1

 +13       QUIT

SE        ;

 +1        NEW VAR

 +2        SET VAR="Could not find AMIE Exam "_EXM

 +3        WRITE !!,VAR

 +4        DO BUMP^DVBAPOST(VAR)

 +5        QUIT

SE1       ;

 +1        NEW VAR

 +2        SET VAR="Addition of exam "_X_" to "_EXM_" has failed."

 +3        WRITE !!,VAR

 +4        DO BUMP^DVBAPOST(VAR)

 +5        QUIT

CHK       ;

 +1        SET DIC="^DVB(396.6,"

           SET DIC(0)="OZ"

           SET X=EXM

           SET D="B"

 +2       ;LOOKUP ONLY ON "B" CROSS REFERENCE

 +3        DO IX^DIC

 +4        IF Y<0

               SET STOP=1

 +5        KILL DIC,X,D

 +6        SET EXAM=+Y

 +7        QUIT

 +8       ;

SG1       ;writes and updates the tmp global with the finish

 +1        NEW LP1,V1

 +2        FOR LP1=1:1:2

               DO BUMPBLK^DVBAPOST

 +3        SET V1="I have updated "_WKSCNT_" exams to the AMIE Exam file."

 +4        WRITE !!,V1

 +5        DO BUMP^DVBAPOST(V1)

 +6        DO BUMPBLK^DVBAPOST

 +7        QUIT

EXIT      ;

 +1        KILL X,Y,STOP,EXAM,LINE,^TMP($JOB,"DVBA"),DVBAVAR

 +2        QUIT

 +3       ;

SETUP     ;

 +1        SET DVBAVAR=$ORDER(^DIC(31,"C",X,""))

 +2        IF DVBAVAR=""

               DO SE3

               SET STOP=1

               QUIT

 +3        IF '$DATA(^DIC(31,DVBAVAR,0))

               DO SE2

               SET STOP=1

               QUIT

 +4        IF $ORDER(^DVB(396.6,EXAM,1,"B",DVBAVAR,""))'=""

               SET STOP=1

               QUIT

 +5        SET X=DVBAVAR

 +6        QUIT

 +7       ;

SE2       ;

 +1        NEW VAR

 +2        SET VAR="Zero node of the "_X_" code does not exist, AMIE Exam "_EXM_".  Please investigate!"

 +3        WRITE !!,VAR

 +4        DO BUMP^DVBAPOST(VAR)

 +5        QUIT

 +6       ;

SE3       ;

 +1        NEW VAR

 +2        SET VAR="'C' cross reference for code "_X_" does not exist, AMIE Exam "_EXM_".  Please investigate!"

 +3        WRITE !!,VAR

 +4        DO BUMP^DVBAPOST(VAR)

 +5        QUIT

DVBAPWKS.m