| 1 | DVBAPWKS ;ALB/CMM AMIE EXAM FILE UPDATE ;1/20/94
 | 
|---|
| 2 |  ;;2.7;AMIE;;Apr 10, 1995
 | 
|---|
| 3 |  ;
 | 
|---|
| 4 | EN ;
 | 
|---|
| 5 |  N WKSCNT
 | 
|---|
| 6 |  S WKSCNT=0
 | 
|---|
| 7 |  D SET
 | 
|---|
| 8 |  D LOOP
 | 
|---|
| 9 |  D SG1
 | 
|---|
| 10 |  D EXIT
 | 
|---|
| 11 |  Q
 | 
|---|
| 12 | SET N VAR
 | 
|---|
| 13 |  S VAR=" - Adding to AMIE Exam File"
 | 
|---|
| 14 |  W !!!,VAR
 | 
|---|
| 15 |  D BUMPBLK^DVBAPOST
 | 
|---|
| 16 |  D BUMPBLK^DVBAPOST
 | 
|---|
| 17 |  D BUMPBLK^DVBAPOST
 | 
|---|
| 18 |  D BUMP^DVBAPOST(VAR)
 | 
|---|
| 19 |  D BUMPBLK^DVBAPOST
 | 
|---|
| 20 | SET1 ;
 | 
|---|
| 21 |  S DIF="^TMP($J,""DVBA"",",XCNP=0
 | 
|---|
| 22 |  K ^TMP($J,"DVBA")
 | 
|---|
| 23 |  F ROU="DVBAPW1","DVBAPW2" S X=ROU X ^%ZOSF("LOAD") W "."
 | 
|---|
| 24 |  K DIF,XCNP,ROU
 | 
|---|
| 25 |  Q
 | 
|---|
| 26 | LOOP ;
 | 
|---|
| 27 |  N LP,EXM,WKS
 | 
|---|
| 28 |  S LP=0
 | 
|---|
| 29 |  F  S LP=$O(^TMP($J,"DVBA",LP)) Q:(LP="")  D
 | 
|---|
| 30 |  .K STOP
 | 
|---|
| 31 |  .S LINE=^TMP($J,"DVBA",LP,0)
 | 
|---|
| 32 |  .I (LINE'[";;")!(LINE[";AMIE;")!(LINE="") Q
 | 
|---|
| 33 |  .S EXM=$P(LINE,";",3)
 | 
|---|
| 34 |  .S WKS=$P(LINE,";",4)
 | 
|---|
| 35 |  .D CHK
 | 
|---|
| 36 |  .I $D(STOP) D SE Q
 | 
|---|
| 37 |  .;;;D ADDW
 | 
|---|
| 38 |  .D ADDE
 | 
|---|
| 39 |  .W:(LP#10) "."
 | 
|---|
| 40 |  Q
 | 
|---|
| 41 | ADDW ;
 | 
|---|
| 42 |  S DIE="^DVB(396.6,",DA=EXAM,DR=".07///"_WKS
 | 
|---|
| 43 |  D ^DIE
 | 
|---|
| 44 |  K DIW,DA,DR,DIE
 | 
|---|
| 45 |  Q
 | 
|---|
| 46 | ADDE ;
 | 
|---|
| 47 |  I '$D(^DVB(396.6,EXAM,1,0)) S ^DVB(396.6,EXAM,1,0)="^396.61P^0^0"
 | 
|---|
| 48 |  F LP1=5:1:999 S X=$P(LINE,";",LP1) Q:X=""  D
 | 
|---|
| 49 |  .K STOP,DA
 | 
|---|
| 50 |  .D SETUP
 | 
|---|
| 51 |  .I $D(STOP) Q
 | 
|---|
| 52 |  .S DLAYGO=396
 | 
|---|
| 53 |  .K DD,DO
 | 
|---|
| 54 |  .S DIC="^DVB(396.6,"_EXAM_",1,",DA(1)=EXAM,DIC(0)="LZM" D FILE^DICN
 | 
|---|
| 55 |  .K DD,DO
 | 
|---|
| 56 |  .I Y<0 D SE1
 | 
|---|
| 57 |  .K DA,DIC,DLAYGO
 | 
|---|
| 58 |  .I Y>0 S WKSCNT=WKSCNT+1
 | 
|---|
| 59 |  Q
 | 
|---|
| 60 | SE ;
 | 
|---|
| 61 |  N VAR
 | 
|---|
| 62 |  S VAR="Could not find AMIE Exam "_EXM
 | 
|---|
| 63 |  W !!,VAR
 | 
|---|
| 64 |  D BUMP^DVBAPOST(VAR)
 | 
|---|
| 65 |  Q
 | 
|---|
| 66 | SE1 ;
 | 
|---|
| 67 |  N VAR
 | 
|---|
| 68 |  S VAR="Addition of exam "_X_" to "_EXM_" has failed."
 | 
|---|
| 69 |  W !!,VAR
 | 
|---|
| 70 |  D BUMP^DVBAPOST(VAR)
 | 
|---|
| 71 |  Q
 | 
|---|
| 72 | CHK ;
 | 
|---|
| 73 |  S DIC="^DVB(396.6,",DIC(0)="OZ",X=EXM,D="B"
 | 
|---|
| 74 |  ;LOOKUP ONLY ON "B" CROSS REFERENCE
 | 
|---|
| 75 |  D IX^DIC
 | 
|---|
| 76 |  I Y<0 S STOP=1
 | 
|---|
| 77 |  K DIC,X,D
 | 
|---|
| 78 |  S EXAM=+Y
 | 
|---|
| 79 |  Q
 | 
|---|
| 80 |  ;
 | 
|---|
| 81 | SG1 ;writes and updates the tmp global with the finish
 | 
|---|
| 82 |  N LP1,V1
 | 
|---|
| 83 |  F LP1=1:1:2 D BUMPBLK^DVBAPOST
 | 
|---|
| 84 |  S V1="I have updated "_WKSCNT_" exams to the AMIE Exam file."
 | 
|---|
| 85 |  W !!,V1
 | 
|---|
| 86 |  D BUMP^DVBAPOST(V1)
 | 
|---|
| 87 |  D BUMPBLK^DVBAPOST
 | 
|---|
| 88 |  Q
 | 
|---|
| 89 | EXIT ;
 | 
|---|
| 90 |  K X,Y,STOP,EXAM,LINE,^TMP($J,"DVBA"),DVBAVAR
 | 
|---|
| 91 |  Q
 | 
|---|
| 92 |  ;
 | 
|---|
| 93 | SETUP ;
 | 
|---|
| 94 |  S DVBAVAR=$O(^DIC(31,"C",X,""))
 | 
|---|
| 95 |  I DVBAVAR="" D SE3 S STOP=1 Q
 | 
|---|
| 96 |  I '$D(^DIC(31,DVBAVAR,0)) D SE2 S STOP=1 Q
 | 
|---|
| 97 |  I $O(^DVB(396.6,EXAM,1,"B",DVBAVAR,""))'="" S STOP=1 Q
 | 
|---|
| 98 |  S X=DVBAVAR
 | 
|---|
| 99 |  Q
 | 
|---|
| 100 |  ;
 | 
|---|
| 101 | SE2 ;
 | 
|---|
| 102 |  N VAR
 | 
|---|
| 103 |  S VAR="Zero node of the "_X_" code does not exist, AMIE Exam "_EXM_".  Please investigate!"
 | 
|---|
| 104 |  W !!,VAR
 | 
|---|
| 105 |  D BUMP^DVBAPOST(VAR)
 | 
|---|
| 106 |  Q
 | 
|---|
| 107 |  ;
 | 
|---|
| 108 | SE3 ;
 | 
|---|
| 109 |  N VAR
 | 
|---|
| 110 |  S VAR="'C' cross reference for code "_X_" does not exist, AMIE Exam "_EXM_".  Please investigate!"
 | 
|---|
| 111 |  W !!,VAR
 | 
|---|
| 112 |  D BUMP^DVBAPOST(VAR)
 | 
|---|
| 113 |  Q
 | 
|---|