| [613] | 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
 | 
|---|