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
Q
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
Q
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) "."
Q
ADDW ;
S DIE="^DVB(396.6,",DA=EXAM,DR=".07///"_WKS
D ^DIE
K DIW,DA,DR,DIE
Q
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
Q
SE ;
N VAR
S VAR="Could not find AMIE Exam "_EXM
W !!,VAR
D BUMP^DVBAPOST(VAR)
Q
SE1 ;
N VAR
S VAR="Addition of exam "_X_" to "_EXM_" has failed."
W !!,VAR
D BUMP^DVBAPOST(VAR)
Q
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
Q
;
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
Q
EXIT ;
K X,Y,STOP,EXAM,LINE,^TMP($J,"DVBA"),DVBAVAR
Q
;
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
Q
;
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)
Q
;
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)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBAPWKS 2308 printed Dec 13, 2024@01:41:57 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
