source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUPUTA.m@ 1166

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

initial load of WorldVistAEHR
File size: 4.5 KB
RevLine 
[613]1TIUPUTA ; SLC/JER - Utilities for C & P Look-up, etc. ;26-MAY-1999 16:38:37
2 ;;1.0;TEXT INTEGRATION UTILITIES;**68**;Jun 20, 1997
3LOOKUP ; Look-up code used by router/filer
4 ; Required: TIUCPFN, TIUSSN
5 N CPDFN,DFN,TIU2507R,TIU25070
6 I $S('$D(TIUSSN):1,$G(TIUCPFN)']"":1,$G(TIUSSN)?4N:1,$G(TIUSSN)']"":1,1:0) S Y=-1 G LOOKUPX
7 I TIUSSN?3N1P2N1P4N.E S TIUSSN=$TR(TIUSSN,"-/","")
8 I TIUSSN["?" S Y=-1 G LOOKUPX
9 K TIUHDR(.02)
10 ;Confirm that exam is for correct patient
11 S DFN=+$$PATIENT^TIULA(TIUSSN)
12 S TIU25070=$G(^DVB(396.4,TIUCPFN,0)),TIU2507R=+$P(TIU25070,U,2)
13 I TIU2507R'>0 S Y=-1 G LOOKUPX
14 S CPDFN=+$G(^DVB(396.3,TIU2507R,0))
15 I CPDFN'=DFN S Y=-1 G LOOKUPX
16 S Y=$$CALLDIC(TIUCPFN)
17LOOKUPX Q
18CALLDIC(TIUX) ; Call ^DIC
19 N DA,DIC,X,Y
20 S DIC=396.4,DIC(0)="NX",X="`"_TIUX D ^DIC
21 Q Y
22FOLLOWUP(TIUDA) ; Post-filing code for C&P's
23 N FDA,FDARR,IENS,FLAGS,TIUMSG,TIU
24 S IENS=""""_TIUDA_",""",FDARR="FDA(396.4,"_IENS_")",FLAGS="K"
25 S @FDARR@(.04)="C"
26 D FILE^DIE(FLAGS,"FDA","TIUMSG")
27 Q
28FIX ; Filing error resolution code for C&P's
29 N %,TIUOUT,AMIEDA,TIUX,TIUPRM0,TIUPRM1,SUCCESS,TIUBUF
30 ; -- first, determine the correct 2507 exam record --
31 F D Q:$D(DUOUT)!$D(DIROUT)!+$G(TIUOUT)
32 . N D0,DK,DL,DIC,X,Y,DA,DX,A,S
33 . W ! S DIC=396.4,DIC(0)="AEMQ"
34 . S DIC("W")="D DICW^TIUPUTA(+Y)"
35 . S DIC("A")="Select 2507 EXAM REFERENCE NUMBER: "
36 . D ^DIC I +Y'>0 S TIUOUT=1 Q
37 . W ! S (DA,AMIEDA)=+Y D EN^DIQ
38 . S TIUOUT=$$READ^TIUU("Y","... OK","YES")
39 Q:$D(DUOUT)!$D(DIROUT)!+$G(DTOUT)!'+$G(AMIEDA)
40 ; -- next, load fields from upload buffer entry --
41 S TIUBUF=$S(+$G(XQADATA):+$G(XQADATA),+$G(BUFDA):+$G(BUFDA),1:"")
42 D LOADTIUX(.TIUX,TIUBUF)
43 ; -- finally, file data in 2507 exam file --
44 D ADDTEXT(AMIEDA,.TIUX)
45 K TIUX("TEXT")
46 D FILE(.SUCCESS,AMIEDA,.TIUX,TIUTYPE)
47 S TIUPOST=$$POSTFILE^TIULC1(TIUTYPE)
48 S TIUREC("#")=AMIEDA
49 I TIUPOST]"" X TIUPOST
50FIXX D ALERTDEL^TIUPEVNT(+TIUBUF)
51 D RESOLVE^TIUPEVNT($S($D(XQADATA):+$P(XQADATA,";",3),1:$G(ERRDA)),1)
52 D BUFPURGE^TIUPUTC(+TIUBUF)
53 W "Done."
54 I +SUCCESS S TIUDONE=1
55 Q
56DICW(TIUDA) ; Write identifiers
57 N X,Y,VADM,VA,VAERR,DVBCP0,DVBCPR0
58 S DVBCP0=^DVB(396.4,+TIUDA,0),DVBCPR0=$G(^DVB(396.3,+$P(DVBCP0,U,2),0))
59 W ?10,$$NAME^TIULS($$NAME^TIULO(+DVBCPR0),"LAST,FIRST MI")," ",?37,$$SSN^TIULO(+DVBCPR0)," ",?52,$P(^DVB(396.6,+$P(DVBCP0,U,3),0),U,2)
60 Q
61LOADTIUX(TIUARR,TIUBUF) ; Load TIUX array with header and text
62 N TIUI,TIUHSIG,TIUBGN,TIULINE,X,Y,TYPE I '$D(TIUPRM0) D SETPARM^TIULE
63 S TIUHSIG=$P(TIUPRM0,U,10),TIUBGN=$P(TIUPRM0,U,12)
64 S TIUI=0 F S TIUI=$O(^TIU(8925.2,+TIUBUF,"TEXT",TIUI)) Q:+TIUI'>0 D
65 . S TIULINE=$G(^TIU(8925.2,+TIUBUF,"TEXT",TIUI,0))
66 . I TIULINE[TIUHSIG D
67 . . N TIUD1,TIUD4
68 . . S X=$$STRIP^TIULS($P(TIULINE,":",2)),Y=$$WHATYPE^TIUPUTU(X)
69 . . I +Y'>0 D MAIN^TIUPEVNT(TIUBUF,1,3,X) Q
70 . . S TIUD1=$G(^TIU(8925.1,+Y,1)),TIUD4=$G(^TIU(8925.1,+Y,4))
71 . . S TYPE=+Y
72 . . F D Q:TIULINE[TIUBGN!(+TIUI'>0)
73 . . . N TIUN,TIUCAP,TIUFLD,TIUREQ S TIUREQ=0
74 . . . S TIUI=$O(^TIU(8925.2,+TIUBUF,"TEXT",TIUI)) Q:+TIUI'>0
75 . . . S TIULINE=$G(^TIU(8925.2,+TIUBUF,"TEXT",TIUI,0)) Q:TIULINE[TIUBGN
76 . . . S TIUCAP=$P(TIULINE,":") Q:TIUCAP']""
77 . . . S TIUN=$O(^TIU(8925.1,+TYPE,"HEAD","B",TIUCAP,0))
78 . . . Q:+TIUN'>0
79 . . . S TIUFLD=$P(^TIU(8925.1,+TYPE,"HEAD",+TIUN,0),U,3)
80 . . . Q:TIUFLD']""
81 . . . S TIUREQ=$P(^TIU(8925.1,+TYPE,"HEAD",+TIUN,0),U,7)
82 . . . S TIUARR(TIUFLD)=$$STRIP^TIULS($P(TIULINE,":",2,99))
83 . . . S:TIUFLD'=.001 TIUARR(TIUFLD)=$$TRNSFRM^TIUPEFIX(+TYPE,TIUFLD,TIUARR(TIUFLD))
84 . . . I +TIUREQ,TIUARR(TIUFLD)="" S TIUARR(TIUFLD)="** REQUIRED FIELD MISSING FROM UPLOAD **"
85 . . . I $S(TIUFLD=.001:1,TIUFLD=.02:1,1:0) K TIUARR(TIUFLD)
86 . . I TIULINE[TIUBGN D
87 . . . N TIUJ S TIUJ=0
88 . . . F D Q:+TIUI'>0
89 . . . . S TIUI=$O(^TIU(8925.2,+TIUBUF,"TEXT",TIUI)) Q:+TIUI'>0
90 . . . . S TIUJ=TIUJ+1
91 . . . . S TIUARR("TEXT",TIUJ,0)=$G(^TIU(8925.2,+TIUBUF,"TEXT",TIUI,0))
92 . . . . S TIUARR("TEXT",0)="^^"_TIUJ_U_TIUJ_U_DT_"^^"
93 Q
94ADDTEXT(AMIEDA,TIUX) ; File Text
95 N TIUI,TIUJ S TIUI=0,TIUJ=+$P($G(^DVB(396.4,+AMIEDA,"RES",0)),U,3)
96 F S TIUI=$O(TIUX("TEXT",TIUI)) Q:+TIUI'>0 D
97 . S TIUJ=TIUJ+1,^DVB(396.4,+AMIEDA,"RES",TIUJ,0)=$G(TIUX("TEXT",TIUI,0))
98 . S ^DVB(396.4,+AMIEDA,"RES",0)="^^"_TIUJ_U_TIUJ_U_DT_"^^"
99 Q
100FILE(SUCCESS,AMIEDA,TIUX,RTYPE) ; Call FM Filer to commit updates to DB
101 N FDA,FDARR,IENS,FLAGS,TIUMSG
102 S IENS=""""_AMIEDA_",""",FDARR="FDA(396.4,"_IENS_")",FLAGS="KE"
103 M @FDARR=TIUX
104 D FILE^DIE(FLAGS,"FDA","TIUMSG") ; File record
105 I $D(TIUMSG)>9 D
106 . S SUCCESS=0_U_$G(TIUMSG(1,"TEXT",1))
107 . D MAIN^TIUPEVNT(TIUBUF,2,"",$P($G(^TIU(8925.1,+RTYPE,0)),U),.FDA,.TIUMSG)
108 S SUCCESS=AMIEDA
109 Q
Note: See TracBrowser for help on using the repository browser.