source: WorldVistAEHR/trunk/r/PCE_PATIENT_CARE_ENCOUNTER-AUTN-EFDP-PX-VSIT--PXRM/PXKMAIN.m@ 1000

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

initial load of WorldVistAEHR
File size: 7.4 KB
RevLine 
[613]1PXKMAIN ;ISL/JVS,ISA/Zoltan - Main Routine for Data Capture ;9/11/98
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;**22,59,73,88,69,117,130,124,174,164**;Aug 12, 1996
3 ;+This routine is responsible for:
4 ;+
5 ;+LOCAL VARIABLE LIST:
6 ;+ PXP59LOC = LOCK name (introduced in patch PX*1.0*59).
7 ;+ PXFG = Stop flag with duplicate of delete
8 ;+ PXKAFT = After node
9 ;+ PXKBEF = Before node
10 ;+ PXKAV = Pieces from the after node
11 ;+ PXKBV = Pieces from the before node
12 ;+ PXKERROR = Set when there is an error
13 ;+ PXKFGAD = ADD flag
14 ;+ PXKFGED = EDIT flag
15 ;+ PXKFGDE = DELETE flag
16 ;+ PXKSEQ = Sequence number in PXK tmp global
17 ;+ PXKCAT = Category of entry (CPT,MSR,VST...)
18 ;+ PXKREF = Root of temp global
19 ;+ PXKPIEN = IEN of v file or the visit file
20 ;+ PXKREF = The original reference we are ordering off of
21 ;+ PXKRT = name of the node in the v file
22 ;+ PXKRTN = routine name for the file routine
23 ;+ PXKSOR = the data source for this entry
24 ;+ PXKSUB = the subscript the data is located on the v file
25 ;+ PXKVST = the visit IEN
26 ;+ PXKDUZ = the DUZ of the user
27 ;+ *PXKHLR* = A variable set by calling routine so that duplicate
28 ;+ PXKERROR messages aren't produced.
29 ;
30 W !,"This is not an entry point" Q
31EN1 ;+Main entry point to read ^TMP("PXK", Global
32 ;+ Partial ^TMP Global Structure when called:
33 ;+ ^TMP("PXK",$J,"SOR") = Source ien
34 ;+
35 ;+ ^TMP("PXK",$J,"VST",1,0,"BEFORE") = the 0-node of the visit file
36 ;+ ^TMP("PXK",$J,"VST",1,0,"AFTER") = 0-node after changes.
37 ;+ ^TMP("PXK",$J,"VST",provider counter,"IEN") = ""
38 ;+
39 ;+ ^TMP("PXK",$J,"PRV",provider counter,0,"BEFORE") = ""
40 ;+ ^TMP("PXK",$J,"PRV",provider counter,0,"AFTER") = Provider id^DFN^Visitien^'P' or 'S' for primary/secondary
41 ;+ ^TMP("PXK",$J,"PRV",provider counter,"IEN") = ""
42 ;+ ^TMP("PXK",$J,"PRV",provider counter,"BEFORE") = ""
43 ;+ ^TMP("PXK",$J,"PRV",provider counter,"AFTER") = ^Package ien^Source ien
44 ;+
45 N PXP59LOC
46 D LOCK
47 K PXKERROR
48 I '$G(PXKDUZ) D
49 . I $G(DUZ) S PXKDUZ=DUZ
50 . E S PXKDUZ=.5
51 D VST
52 I $D(PXP59LOC) D UNLOCK
53 Q
54VST ;--Check for visit node and get one created or quit.
55 I '$G(^TMP("PXK",$J,"VST",1,"IEN")) D
56 .D VSIT^PXKVST
57 I +$G(^TMP("PXK",$J,"VST",1,"IEN"))=-1 S PXKERROR("VISIT")="Visit Tracking could not get a visit." Q
58 I +$G(^TMP("PXK",$J,"VST",1,"IEN"))=-2 S PXKERROR("VISIT")="PCE is not activated in Visit Tracking Parameters and thus cannot create visits." Q
59 I +$G(^TMP("PXK",$J,"VST",1,"IEN"))<1 S PXKERROR("VISIT")="Did not get a visit^"_$G(^TMP("PXK",$J,"VST",1,"IEN")) Q
60 ;
61NEW ;--New variables and set main variables
62 N PXKDFN,PXKSOR,PXKVST,PXKSEQ,PXFG,PXKAFT,PXKBEF,PXKAUDIT
63 N PXKCAT,PXKER,PXKFGAD,PXKFGED,PXKFGDE,PXKNOD,PXKPCE
64 N PXKPIEN,PXKREF,PXKRTN,PXKSORR,PXKSUB,PXKVCAT
65 N PXKPTR,PXDFG,PX,PXJJJ,PXKAFT8,PXKAFTR,PXKGN,PXKN,PXKP
66 N PXKRRT,PXKVRTN,PXKRT,PXKFVDLM,TMPPX
67PRVTYPE ;---DO PROVIDER TYPE--PXKMAIN2
68 D PRVTYPE^PXKMAIN2
69 ;
70SET ;--SET VARIABLES NECESSARY
71 ;'DA' should not be defined at this point
72 N DA ;PX*1.0*117
73 ;
74 S PXFG=0,TMPPX="^",PXKLAYGO="",PXDFG=0
75SOURCE S PXKSOR=$G(^TMP("PXK",$J,"SOR")) D Q:$D(PXKERROR("SOURCE"))
76 .S PXKCO("SOR")=PXKSOR
77 .I $D(PXKSOR)']"" S PXKERROR("SOURCE")="" Q
78VISIT S (PXKVST,VSIT("IEN"))=$G(^TMP("PXK",$J,"VST",1,"IEN"))
79ORDER ;--$ORDER Through the ^TMP("PXK", global setting variables
80 S PXKREF="^TMP(""PXK"",$J)"
81CATEG S PXKCAT="" F S (PXKCAT,PXKVCAT)=$O(@PXKREF@(PXKCAT)) Q:PXKCAT="" D
82 .I PXKCAT="VST" S PXKVCAT="SIT"
83 .S PXKRTN="PXKF"_PXKCAT
84 .S X=PXKRTN X ^%ZOSF("TEST") Q:'$T
85SEQUE .S PXKSEQ=0 F S PXKSEQ=$O(@PXKREF@(PXKCAT,PXKSEQ)) K PXKAV,PXKBV S PXFG=0 Q:'PXKSEQ D
86 ..S PXKPIEN=$G(@PXKREF@(PXKCAT,PXKSEQ,"IEN")),(PXKFGAD,PXKFGDE,PXKFGED,PXDFG)=0
87SUBSCR ..S PXKSUB="" F S PXKSUB=$O(@PXKREF@(PXKCAT,PXKSEQ,PXKSUB)) Q:PXKSUB["IEN" Q:PXFG=1 Q:PXDFG=1 D
88AFTER ...S PXKAFT(PXKSUB)=$G(@PXKREF@(PXKCAT,PXKSEQ,PXKSUB,"AFTER"))
89BEFORE ...S PXKBEF(PXKSUB)=$G(@PXKREF@(PXKCAT,PXKSEQ,PXKSUB,"BEFORE"))
90 ...I PXKCAT="CPT",PXKSUB=1 D SUBSCR^PXKMOD
91 ...D LOOP^PXKMAIN1 D ERROR^PXKMAIN1 S PXDFG=0 I $G(PXKAV(0,1))["@"!('$D(PXKAV(0,1))) S PXKAFT(PXKSUB)="" K PXKAV(0) S PXDFG=1
92 ..Q:PXFG=1
93 ..I $D(PXKAV),'$D(PXKBV) S PXKSORR=PXKSOR_"-A "_PXKDUZ,PXKFGAD=1 I PXKCAT["VST" S PXKFGAD=0
94 ..I '$D(PXKAV),$D(PXKBV) S PXKFGDE=1,PXKFVDLM="" D
95 ...S PXKRT=$P($T(GLOBAL^@PXKRTN),";;",2)_"("_PXKPIEN_")" I $D(@PXKRT) D DELETE^PXKMAIN1,EN1^PXKMASC S PXFG=1 K PXKRT Q
96 ..I 'PXKFGAD,'PXKFGDE D
97 ...I PXKCAT="VST" D CQDEL
98 ...D CLEAN^PXKMAIN1
99 ...I $D(PXKAV) S PXKSORR=PXKSOR_"-E "_PXKDUZ,PXKFGED=1 I PXKCAT="VST",'$D(PXKBV),$D(PXKVST) S PXKFGED=0
100 ..I 'PXKFGAD,'PXKFGDE,'PXKFGED,PXKCAT["VST" D EN1^PXKMASC
101 ..I PXKFGAD=1 D Q:PXFG
102 ...D ERROR^PXKMAIN1
103 ...I $D(PXKERROR(PXKCAT,PXKSEQ)) S PXFG=1
104 ...D:'PXFG DUP^PXKMAIN1
105 ...I PXFG=1 D Q
106 ....Q:PXKCAT'="CPT"
107 ....I $G(@PXKREF@(PXKCAT,PXKSEQ,"IEN"))]"" D REMOVE^PXCEVFIL(@PXKREF@(PXKCAT,PXKSEQ,"IEN"))
108 ...D:'PXKPIEN FILE^PXKMAIN1
109 ...S:'$G(DA) DA=PXKPIEN
110 ...D AUD2^PXKMAIN1,DRDIE^PXKMAIN1,EN1^PXKMASC
111 ..I PXKFGED=1,PXKCAT'="VST" S PXKRT=$P($T(GLOBAL^@PXKRTN),";;",2)_"("_PXKPIEN_")" Q:'$D(@PXKRT) S DA=PXKPIEN D DUP^PXKMAIN1 Q:PXFG=1 D AUD12^PXKMAIN1,DRDIE^PXKMAIN1,EN1^PXKMASC
112 ..I PXKFGED=1,PXKCAT="VST" S PXKRT=$P($T(GLOBAL^@PXKRTN),";;",2)_"("_PXKPIEN_")" Q:'$D(@PXKRT) S DA=PXKPIEN D DUP^PXKMAIN1 Q:PXFG=1 D DRDIE^PXKMAIN1,EN1^PXKMASC
113 ..D SPEC^PXKMAIN2
114 ..K PXKAFT,PXKBEF
115 I $D(^TMP("PXKSAVE",$J)) D RECALL^PXKMAIN2
116 D EXIT
117 Q
118EXIT ;--EXIT
119 I $D(PXKFVDLM) D MODIFIED^VSIT(PXKVST)
120 K PXKPXD,TMPPX
121 K DA,DR,PXKI,PXKJ,PXKLAYGO,PXKDUZ,PXKAFT8,PXKAFTR,VSIT("IEN") Q
122EVENT ;--ENTRY POINT TO POST EXECUTE PCE'S EVENT
123 ;Setting the variable PXKNOEVT=1 will stop the event from being
124 ;fired off whenever any data is sent into PCE
125 ;
126 ;PX*1*124 AUTO-POPULATE THE ENCOUNTER SC/EI BASED ON THE ENCOUNTER DX'S
127 ;PX*1.0*164 Relocate the PXCECCLS call
128 I $D(^TMP("PXKCO",$J)) D
129 . S PXKVVST=+$O(^TMP("PXKCO",$J,0))
130 . I $G(PXKVVST) D VST^PXCECCLS(PXKVVST) ;PX*1.0*174
131 ;
132 I $G(PXKNOEVT) K ^TMP("PXKCO",$J) Q
133 N PXP59LOC
134 D LOCK
135 D EVENT^PXKMASC
136 I $D(PXP59LOC) D UNLOCK
137 Q
138LOCK ; Lock (results in PXP59LOC)--Patch PX*1.0*59.
139 N PX0,PXWHO,PXWHERE,PXWHEN,PXEXIT,PXVISIT
140 S PXEXIT=1,(PXWHO,PXWHERE,PXWHEN)=""
141 ;First case: new visit data being saved.
142 I 11[$D(^TMP("PXK",$J,"VST",1,0,"AFTER")) D
143 . S PX0=^TMP("PXK",$J,"VST",1,0,"AFTER")
144 . D L2
145 ;Second case: use existing visit data.
146 I 11[$D(^TMP("PXK",$J,"VST",1,"IEN")) D
147 . S PXVISIT=+^TMP("PXK",$J,"VST",1,"IEN")
148 . Q:'PXVISIT
149 . Q:$D(^AUPNVSIT(PXVISIT,0))[0
150 . S PX0=^AUPNVSIT(PXVISIT,0)
151 . D L2
152 ;Third case: Uses "PXKCO" instead of "PXK".
153 I PXEXIT,$D(^TMP("PXKCO",$J)) D
154 . S PXVISIT=$O(^TMP("PXKCO",$J,0))
155 . Q:'PXVISIT
156 . S PX0=$G(^TMP("PXKCO",$J,PXVISIT,"VST",PXVISIT,0,"AFTER"))
157 . Q:PX0=""
158 . D L2
159 ;Fourth case: Uses "PXKENC" instead of "PXK".
160 I PXEXIT,$D(^TMP("PXKENC",$J)) D
161 . S PXVISIT=$O(^TMP("PXKENC",$J,0))
162 . Q:'PXVISIT
163 . S PX0=$G(^TMP("PXKENC",$J,PXVISIT,"VST",PXVISIT,0)) ; Look at ^TMP("PXKENC",$J
164 . Q:PX0=""
165 . D L2
166 I PXEXIT Q ; Unable to obtain non-null subscripts.
167 S PXP59LOC=$NA(^PXLOCK(PXWHO,PXWHERE,PXWHEN))
168 L +@PXP59LOC:300
169 E K PXP59LOC ; Lock was unsuccessful.
170 Q
171L2 ; Get values from visit 0 node (PX0).
172 I 'PXWHO S PXWHO=$P(PX0,U,5)
173 I 'PXWHEN S PXWHEN=$P(PX0,U,1)
174 I 'PXWHERE S PXWHERE=+$P(PX0,U,22)
175 I PXWHO,PXWHEN S PXEXIT=0
176 Q
177UNLOCK ; Unlock (use info in PXP59LOC)--Patch PX*1.0*59.
178 L -@PXP59LOC
179 Q
180 ;
181CQDEL ;Classification question deletion check
182 I PXKCAT'="VST" Q
183 S PXJ="" F S PXJ=$O(PXKBV(800,PXJ)) Q:'PXJ I PXKBV(800,PXJ)'="" I '$D(PXKAV(800,PXJ)) S PXKAV(800,PXJ)="@"
184 K PXJ Q
Note: See TracBrowser for help on using the repository browser.