source: WorldVistAEHR/trunk/r/AUTOMATED_MED_INFO_EXCHANGE-DVBA-DVBC/DVBAPWKS.m@ 810

Last change on this file since 810 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.1 KB
Line 
1DVBAPWKS ;ALB/CMM AMIE EXAM FILE UPDATE ;1/20/94
2 ;;2.7;AMIE;;Apr 10, 1995
3 ;
4EN ;
5 N WKSCNT
6 S WKSCNT=0
7 D SET
8 D LOOP
9 D SG1
10 D EXIT
11 Q
12SET 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
20SET1 ;
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
26LOOP ;
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
41ADDW ;
42 S DIE="^DVB(396.6,",DA=EXAM,DR=".07///"_WKS
43 D ^DIE
44 K DIW,DA,DR,DIE
45 Q
46ADDE ;
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
60SE ;
61 N VAR
62 S VAR="Could not find AMIE Exam "_EXM
63 W !!,VAR
64 D BUMP^DVBAPOST(VAR)
65 Q
66SE1 ;
67 N VAR
68 S VAR="Addition of exam "_X_" to "_EXM_" has failed."
69 W !!,VAR
70 D BUMP^DVBAPOST(VAR)
71 Q
72CHK ;
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 ;
81SG1 ;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
89EXIT ;
90 K X,Y,STOP,EXAM,LINE,^TMP($J,"DVBA"),DVBAVAR
91 Q
92 ;
93SETUP ;
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 ;
101SE2 ;
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 ;
108SE3 ;
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
Note: See TracBrowser for help on using the repository browser.