source: FOIAVistA/tag/r/AUTOMATED_INFO_COLLECTION_SYS-IBD/IBDF18C.m@ 636

Last change on this file since 636 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version
File size: 6.9 KB
Line 
1IBDF18C ;ALB/CJM/AAS - ENCOUNTER FORM - form ID utilities ;04-OCT-94
2 ;;3.0;AUTOMATED INFO COLLECTION SYS;**5,9**;APR 24, 1997
3 ;
4FID(DFN,APPT,SOURCE,FORMTYPE,CLIN) ; -- Form ID Tracking
5 ; -- create record in the ENCOUNTER FORM TRACKING file
6 ; and returned a unique FORM ID
7 ; -- Input DFN = patient internal entry number
8 ; APPT = appointment date time (fm format)
9 ; SOURCE = the source of the form, ie
10 ; IB = 1
11 ; Pandas = 2
12 ; Telefr = 3
13 ; FORMTYPE = the package form definition ID - may have been exterally assigned
14 ; CLIN = pointer to 44 (optional)
15 ;
16 ; -- Output Returns = internal form id^external form id
17 ;
18 N I,J,X,Y,ID,EXID,CLN,INTERNAL,NODE,FORMID,DIC,DIE,DA,DR,DINUM,DLAYGO
19 S ID=-1,EXID=""
20 ;
21 I '$G(DFN)!('$G(APPT))!('$G(SOURCE)) G FIDQ
22 ;
23 ; -- FORMTYPE may="", but should always be >0 for scannable forms
24 S FORMTYPE=+$G(FORMTYPE)
25 S FORMID("APPT")=APPT,FORMID("SOURCE")=1
26 ;
27 ; -- determine if the FORMTYPE was exterally assigned
28 S INTERNAL=$D(^IBD(357.95,"C",SOURCE,FORMTYPE))
29 ;
30 ;
31 S ID=$$FINDID(DFN,APPT,FORMTYPE) I ID S EXID=ID_"^"_$P($G(^IBD(357.96,ID,0)),"^",9) G FIDQ
32 K DIC,DO,D0,DD,DA,DINUM
33 S DIC="^IBD(357.96,",X=ID,DIC(0)="L",DLAYGO=357.96,DINUM=ID
34 ;
35 L +^IBD(357.97,1,.02):3
36 S ID=+$P($G(^IBD(357.97,1,0)),"^",2)
37 F ID=ID+1:1 L:$D(^IBD(357.96,(ID-1))) -^IBD(357.96,(ID-1)) I ID>0,'$D(^IBD(357.96,ID)) L +^IBD(357.96,ID):1 I $T,'$D(^IBD(357.96,ID)) S (X,DINUM)=ID D FILE^DICN I +Y>0 L -^IBD(357.96,ID) Q
38 S $P(^IBD(357.97,1,0),"^",2)=ID
39 L -^IBD(357.97,1,.02)
40 ;
41 S ID=$S(+Y<1:"",1:+Y) I ID="" D LOGERR^IBDF18E2(3579600,.FORMID) G FIDQ
42 D:ID
43 .S EXID=$$EXID(ID)
44 .S DIE="^IBD(357.96,",DA=ID
45 .S DR="[IBD CREATE FORM TRACKING]"
46 .L +^IBD(357.96,ID):5 D ^DIE L -^IBD(357.96,ID)
47 .K DIC,DIE,DA,DR,DINUM,DLAYGO,%,%H,%I
48 .;
49 .;D NOW^%DTC N IBPRDT S IBPRDT=% ;Not needed with template, delete
50 .;S DR=".02////^S X=DFN;.03////^S X=APPT;.04////^S X=$S(INTERNAL:FORMTYPE,1:"""");.05////^S X=IBPRDT;.07////^S X=SOURCE;.08////^S X=$S('INTERNAL:FORMTYPE,1:"""");.09////^S X=EXID;.1////^S X=$G(CLIN);.11////1"
51 .;I $G(^DPT(DFN,"S",APPT,0))="" S DR=DR_";.14////1"
52FIDQ Q ID_"^"_EXID
53 ;
54EXID(ID) ; -- converts external id format to internal id format
55 ; -- we need to decide on external id format
56 Q $G(ID)
57 ;
58INID(ID) ; -- find internal id number from external format
59 ; -- Input ID = form id in external format
60 ; Output = form id in internal format or NULL if nonexistant
61 ;
62 N EXID
63 S EXID=$O(^IBD(357.96,"AEXT",ID,0))
64INIDQ Q $G(EXID)
65 ;
66FSCND(ID,STAT,ERR) ; -- update form tracking file that
67 ; -- Input ID = entry to flag as scanned (internal format)
68 ; STAT = NEW status, 1=printed, 2=scanned,3=sent to pce okay,
69 ; 4=pce returned err
70 ; 11=pending pages, 12=input data error
71 ; ERR = pce error message (required only if stat=4)
72 ;
73 ; -- Output = 1 if successful, 0 if not
74 ;
75 N IBI,SUCCESS,I,J,X,Y,DA,DR,DIC,DIE
76 S SUCCESS=0
77 I '$G(ID) G FSCNDQ
78 I $G(STAT)=4,$G(ERR)="" G FSCNDQ
79 ;
80 ; -- three lines below use template, new for t6, uncommend and delete
81 ; remaining lines
82 S DIE="^IBD(357.96,",DA=ID,DR="[IBD EDIT FORM TRACKING STATUS]"
83 D ^DIE
84 S SUCCESS=1
85 ;
86 ;S IBI=$G(^IBD(357.96,+ID,0)) I IBI="" G FSCND
87 ;I $P(IBI,"^",6)="" S DIE="^IBD(357.96,",DA=ID,DR=".06///NOW;.11////^S X=$S($G(STAT):STAT,1:2);.12////^S X=$G(ERR)" D ^DIE S SUCCESS=1 G FSCNDQ
88 ;S DIE="^IBD(357.96,",DA=+ID,DR=".11////^S X=$G(STAT);.12////^S X=$G(ERR)" D ^DIE S SUCCESS=1
89 ;
90FSCNDQ Q SUCCESS
91 ;
92FIDST(ID) ; -- form id status
93 ; -- Input ID = form id (internal entry number)
94 ;
95 ; -- Output STATUS = -1 if id does not exist
96 ; = 1 if id exists but not scanned (printed)
97 ; = 2 if already scanned in
98 ; = 3 if sent to pce okay
99 ; = 4 if sent to pce with error....
100 ;
101 N STATUS,I,J,X,Y
102 S STATUS=-1
103 I '$G(ID) G FIDSTQ
104 S X=$G(^IBD(357.96,ID,0)) I X="" G FIDSTQ
105 S STATUS=$S($P(X,"^",6)="":1,1:2)
106 S:$P(X,"^",11)>2 STATUS=$P(X,"^",11)
107FIDSTQ Q STATUS
108 ;
109FINDID(DFN,APPT,FORM,DUP) ; -- Find a form id for a patient and appointment
110 ; -- input DFN = patient
111 ; APPT = appointment date time
112 ; FORM = (Optional) type of form, pointer to 357.95 or field 10
113 ; DUP = (Optional) if true, No duplicates of same form (357)
114 ; returns last printing of same form with different
115 ; form definitions, will also exclude nonscannable form
116 ;
117 ; -- output = form id1^form id2^form id3^form idn...
118 ; = where form ids are successive form ids (in internal
119 ; format) for same appointment
120 ;
121 N ID,I,J,X,ORIGIN,OLDDATE,NEWDATE
122 S ID=""
123 I '$G(DFN)!('$G(APPT)) G FINDIDQ
124 K ^TMP($J,"IBD-FINDID")
125 S CLN=+$G(^DPT(DFN,"S",APPT,0)) ;get clinic if appointment
126 ;
127 I '$G(DUP) S X=0 F S X=$O(^IBD(357.96,"APTAP",DFN,APPT,X)) Q:'X D
128 .I CLN,CLN'=$P($G(^IBD(357.96,X,0)),"^",10) Q ;form for canceled appt.
129 .I '$G(FORM) S ID=ID_X_"^" Q
130 .I $G(FORM) S I=$G(^IBD(357.96,X,0)) I $P(I,"^",4)=FORM!($P(I,"^",8)=FORM) S ID=X Q
131 ;
132 I $G(DUP) S X=0 F S X=$O(^IBD(357.96,"APTAP",DFN,APPT,X)) Q:'X D
133 .I +$P($G(^IBE(357,+$P($G(^IBD(357.95,+$P($G(^IBD(357.96,X,0)),"^",4),0)),"^",21),0)),"^",12)<1 Q
134 .I CLN,CLN'=$P($G(^IBD(357.96,X,0)),"^",10) Q ;form for canceled appt.
135 .S ORIGIN=$P($G(^IBD(357.95,+$P($G(^IBD(357.96,X,0)),"^",4),0)),"^",21) Q:'ORIGIN
136 .I '$G(FORM) D
137 ..I '$D(^TMP($J,"IBD-FINDID",ORIGIN)) S ^TMP($J,"IBD-FINDID",ORIGIN)=X Q
138 ..S OLDDATE=$P($G(^IBD(357.96,+$G(^TMP("IBD-FINDID",ORIGIN)),0)),"^",5)
139 ..S NEWDATE=$P($G(^IBD(357.96,X,0)),"^",5)
140 ..I NEWDATE'<OLDDATE S ^TMP($J,"IBD-FINDID",ORIGIN)=X
141 .I $G(FORM) S I=$G(^IBD(357.96,X,0)) I $P(I,"^",4)=FORM!($P(I,"^",8)=FORM) S ID=X Q
142 I $G(DUP),'$G(FORM) S ORIGIN=0 F S ORIGIN=$O(^TMP($J,"IBD-FINDID",ORIGIN)) Q:'ORIGIN S ID=ID_^TMP($J,"IBD-FINDID",ORIGIN)_"^"
143 ;
144FINDIDQ K ^TMP($J,"IBD-FINDID")
145 Q ID
146 ;
147FINDPT(FORMID) ;
148 ; -- find patient from form id
149 ; -- Output :Patient Name ^ PID ^ clinic Name ^ appt date/time (external)
150 ; ^form ID ^ form status ^ DFN ^ clinic ien ^ appt date/time (fm format)
151 ;
152 N I,J,X,Y,DFN,IBNODE,IBXX,VA,VADM,VAERR,STATNM,FORM,FORMNM
153 S IBXX="Unable to identify Form^^^"
154 I +$G(FORMID)<1 G FINDPTQ
155 S IBNODE=$G(^IBD(357.96,+FORMID,0))
156 I IBNODE="" G FINDPTQ
157 S DFN=+$P(IBNODE,"^",2)
158 D DEM^VADPT
159 S Y=$P(IBNODE,"^",11),C=$P(^DD(357.96,.11,0),"^",2) D Y^DIQ S STATNM=Y
160 S FORM=$P($G(^IBD(357.95,+$P(IBNODE,"^",4),0)),"^",21)
161 S FORMNM=$P($G(^IBE(357,+FORM,0)),"^")
162 ;
163 S IBXX=$G(VADM(1))_"^"_$G(VA("PID"))_"^"_$P($G(^SC(+$P(IBNODE,"^",10),0),"Clinic Not Specified"),"^")_"^"_$$FMTE^XLFDT($P(IBNODE,"^",3))_"^"_$P(IBNODE,"^",4)_"^"_$P(IBNODE,"^",11)_"^"_DFN
164 S IBXX=IBXX_"^"_$P(IBNODE,"^",10)_"^"_$P(IBNODE,"^",3)_"^"_STATNM_"^"_FORMNM_"^"_FORM
165 ;
166 I +$P(FORMID,"^",2)>0,$P(IBNODE,"^",4)'=+$P(FORMID,"^",2) S IBXX="Form Type and Form ID Don't match^^^"
167 ;
168FINDPTQ Q IBXX
Note: See TracBrowser for help on using the repository browser.