| 1 | DVBAPBDY ;ALB/CMM BODY SYSTEM FILE UPDATE ;1/19/94
|
|---|
| 2 | ;;2.7;AMIE;;Apr 10, 1995
|
|---|
| 3 | ;
|
|---|
| 4 | EN ;
|
|---|
| 5 | N BDYCNT
|
|---|
| 6 | S BDYCNT=0
|
|---|
| 7 | D SET
|
|---|
| 8 | D LOOP
|
|---|
| 9 | D SG1
|
|---|
| 10 | D EXIT
|
|---|
| 11 | Q
|
|---|
| 12 | SET N VAR
|
|---|
| 13 | S VAR=" - Adding to 2507 Body System File."
|
|---|
| 14 | D BUMPBLK^DVBAPOST
|
|---|
| 15 | D BUMPBLK^DVBAPOST
|
|---|
| 16 | D BUMPBLK^DVBAPOST
|
|---|
| 17 | W !!!,VAR
|
|---|
| 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="DVBAPB1" S X=ROU X ^%ZOSF("LOAD") W "."
|
|---|
| 24 | K DIF,XCNP,ROU
|
|---|
| 25 | Q
|
|---|
| 26 | LOOP ;
|
|---|
| 27 | N LP,LP1
|
|---|
| 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 BODY=$P(LINE,";",3)
|
|---|
| 34 | .D GET
|
|---|
| 35 | .I $D(STOP) Q
|
|---|
| 36 | .I '$D(^DVB(396.7,BODY,1,0)) S ^DVB(396.7,BODY,1,0)="^396.701P^0^0"
|
|---|
| 37 | .F LP1=4:1:999 S X=$P(LINE,";",LP1) Q:X="" D
|
|---|
| 38 | ..K STOP
|
|---|
| 39 | ..D CHK
|
|---|
| 40 | ..I $D(STOP) Q
|
|---|
| 41 | ..K DA
|
|---|
| 42 | ..D SETUP
|
|---|
| 43 | ..I $D(STOP) Q
|
|---|
| 44 | ..K DD,DO
|
|---|
| 45 | ..S DLAYGO=396,DIC="^DVB(396.7,"_BODY_",1,",DA(1)=BODY,DIC(0)="LMZ" D FILE^DICN
|
|---|
| 46 | ..K DIC,DA,DLAYGO,DD,DO
|
|---|
| 47 | ..I Y<0 D SE Q
|
|---|
| 48 | ..W:'(LP1#10) "."
|
|---|
| 49 | ..S BDYCNT=BDYCNT+1
|
|---|
| 50 | Q
|
|---|
| 51 | GET ;
|
|---|
| 52 | K DIC
|
|---|
| 53 | S DIC="^DVB(396.7,",X=BODY,DIC(0)="MOZ"
|
|---|
| 54 | D ^DIC
|
|---|
| 55 | I Y<0 D SE1 S STOP=1 Q
|
|---|
| 56 | S BODY=+Y
|
|---|
| 57 | Q
|
|---|
| 58 | SE ;
|
|---|
| 59 | N VAR
|
|---|
| 60 | S VAR="Could not add code "_X_" to body system "_BODY
|
|---|
| 61 | W !!,VAR
|
|---|
| 62 | D BUMP^DVBAPOST(VAR)
|
|---|
| 63 | Q
|
|---|
| 64 | SE1 ;
|
|---|
| 65 | N VAR
|
|---|
| 66 | S VAR="Could not find body system "_BODY
|
|---|
| 67 | W !!,VAR
|
|---|
| 68 | D BUMP^DVBAPOST(VAR)
|
|---|
| 69 | Q
|
|---|
| 70 | CHK ;
|
|---|
| 71 | N COD,COD1
|
|---|
| 72 | S COD=$O(^DIC(31,"C",X,""))
|
|---|
| 73 | I COD="" S STOP=1 W !,"Error adding exam "_X Q
|
|---|
| 74 | S COD1=$O(^DVB(396.7,BODY,1,"B",COD,""))
|
|---|
| 75 | I COD1'="" S STOP=1
|
|---|
| 76 | Q
|
|---|
| 77 | SG1 ;writes and updates the tmp global with the finish
|
|---|
| 78 | N LP1,V1
|
|---|
| 79 | F LP1=1:1:2 D BUMPBLK^DVBAPOST
|
|---|
| 80 | S V1="I have updated "_BDYCNT_" exams to the 2507 Body System File!"
|
|---|
| 81 | W !!,V1
|
|---|
| 82 | D BUMP^DVBAPOST(V1)
|
|---|
| 83 | D BUMPBLK^DVBAPOST
|
|---|
| 84 | Q
|
|---|
| 85 | EXIT ;
|
|---|
| 86 | K X,Y,BODY,STOP,LINE,^TMP($J,"DVBA")
|
|---|
| 87 | Q
|
|---|
| 88 | SETUP ;
|
|---|
| 89 | S DVBAVAR=$O(^DIC(31,"C",X,""))
|
|---|
| 90 | I '$D(^DIC(31,DVBAVAR,0)) D SE2 S STOP=1 Q
|
|---|
| 91 | S X=DVBAVAR
|
|---|
| 92 | Q
|
|---|
| 93 | SE2 ;
|
|---|
| 94 | N VAR
|
|---|
| 95 | S VAR="Zero node of the "_X_" code does not exist. Please investigate!"
|
|---|
| 96 | W !!,VAR
|
|---|
| 97 | D BUMP^DVBAPOST(VAR)
|
|---|
| 98 | Q
|
|---|
