source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUPUTS.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: 6.3 KB
Line 
1TIUPUTS ; SLC/JER - Surgery Look-up, etc. ; 04/19/2004
2 ;;1.0;TEXT INTEGRATION UTILITIES;**112,187,173,195,204**;Jun 20, 1997
3LOOKUP ; Look-up code used by router/filer
4 ; Required: TIUSRCN, TIUSDA, TIUSSN, TIUODT
5 N SRODT,DFN,TIUSR0,TIUD0,TIUDAD
6 I $S('$D(TIUSSN):1,$G(TIUSSN)?4N:1,$G(TIUSSN)']"":1,+$G(TIUODT)'>0: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 S DFN=+$$PATIENT^TIULA(TIUSSN)
10 I DFN'>0 S Y=-1 G LOOKUPX
11 I +$G(TIUSRCN)=0 S TIUSRCN=$$FINDCASE(DFN,+$$IDATE^TIULC(TIUODT))
12 I +$G(TIUSRCN)'>0 S Y=-1 G LOOKUPX
13 I +$G(TIUSDA)'>0,$D(^SRF(TIUSRCN,"TIU")) S TIUSDA=$$GETSDA(TIUSRCN)
14 I +$G(TIUSDA)'>0 D G LOOKUPX
15 . S Y=-1
16 . I '$D(^SRF(TIUSRCN,"TIU")),'$D(ZTQUEUED) D
17 . . W !!,"Time Out of O.R. has not yet been entered for Surgical Case #",TIUSRCN
18 . . W !,"the Surgical Service must complete this step before the Operation"
19 . . W !,"Report can be uploaded..."
20 K TIUHDR(.001),TIUHDR(.02),TIUHDR(.07),TIUHDR(1405)
21 S TIUD0=$G(^TIU(8925,TIUSDA,0)),TIUSR0=$G(^SRF(TIUSRCN,0))
22 ;Confirm that SURGICAL CASE is for correct patient
23 I +TIUSR0'=DFN S Y=-1 G LOOKUPX
24 ;Confirm that TIU DOCUMENT is for correct patient
25 I +$P(TIUD0,U,2)'=DFN S Y=-1 G LOOKUPX
26 ;Confirm that OPERATION DATE is correct
27 I +$$IDATE^TIULC(TIUODT)'=$P($P(TIUSR0,U,9),".") S Y=-1 G LOOKUPX
28 S Y=$$CALLDIC(TIUSDA)
29 I '+$$CANEDIT(+Y) D
30 . W !,"Existing document may not be edited...Creating Addendum."
31 . S TIUDAD=+Y,Y=$$MAKEADD^TIUPUTU()
32 . D COPYDAD(Y,TIUDAD)
33LOOKUPX K TIUSRCN,TIUSDA
34 Q
35CANEDIT(DA) ; Check whether or not document is released
36 Q $S(+$P($G(^TIU(8925,+DA,0)),U,5)<4:1,1:0)
37COPYDAD(DA,PARENT) ; copy fixed field data for addenda
38 N FDA,FDARR,IENS,FLAGS,TIUMSG,TIUOPDT,TIURDT,TIUD0,TIUD12,TIUD14
39 S TIUD0=$G(^TIU(8925,+PARENT,0)),TIUD12=$G(^(12)),TIUD14=$G(^(14))
40 S IENS=""""_DA_",""",FDARR="FDA(8925,"_IENS_")",FLAGS="K"
41 S @FDARR@(.02)=$P(TIUD0,U,2)
42 S @FDARR@(.03)=$P(TIUD0,U,3),@FDARR@(.05)=3
43 S @FDARR@(.06)=PARENT,@FDARR@(.08)=$P(TIUD0,U,8)
44 S @FDARR@(1401)=$P(TIUD14,U)
45 S @FDARR@(1402)=$P(TIUD14,U,2)
46 S @FDARR@(1405)=TIUSRCN_";SRF("
47 S @FDARR@(1201)=$$NOW^TIULC
48 S @FDARR@(1205)=$P(TIUD12,U,5)
49 S TIUOPDT=+$$IDATE^TIULC($G(TIUODT))
50 S TIURDT=$S(+$G(TIUOPDT)>0:+$G(TIUOPDT),1:+$$NOW^XLFDT)
51 S @FDARR@(1301)=TIURDT,@FDARR@(1303)="U"
52 D FILE^DIE(FLAGS,"FDA","TIUMSG") ; File record
53 Q
54FINDCASE(DFN,TIUODT) ; Find Surgical Case for Pt & Dt, if unique
55 N TIUY,TIUCN,TIUHIT,TIUPOP S TIUCN="",(TIUY,TIUHIT,TIUPOP)=0
56 F S TIUCN=$O(^SRF("B",DFN,TIUCN),-1) Q:TIUCN'>0!+TIUPOP D
57 . N TIUSR0 S TIUSR0=$G(^SRF(TIUCN,0))
58 . I +$G(TIUODT)=$P($P(TIUSR0,U,9),".") D
59 . . I +TIUHIT S TIUPOP=1 Q
60 . . S TIUHIT=TIUCN
61 I 'TIUPOP,TIUHIT S TIUY=TIUHIT
62 Q TIUY
63GETSDA(TIUSRCN) ; Get Op Report for Case
64 N TIUY S TIUY=+$P(^SRF(TIUSRCN,"TIU"),U)
65 I 'TIUY S TIUY=+$P(^SRF(TIUSRCN,"TIU"),U,3)
66 Q TIUY
67CALLDIC(TIUX) ; Call ^DIC to get the IEN for the TIU DOCUMENT
68 N DA,DIC,X,Y
69 S DIC=8925,DIC(0)="NX",X="`"_TIUX D ^DIC
70 Q Y
71FOLLOWUP(TIUDA) ; Post-filing code for Operation Reports
72 N FDA,FDARR,IENS,FLAGS,TIUMSG,TIU
73 S IENS=""""_TIUDA_",""",FDARR="FDA(8925,"_IENS_")",FLAGS="K"
74 D GETTIU^TIULD(.TIU,TIUDA)
75 I $L($G(TIU("EDT"))) S @FDARR@(.07)=$P($G(TIU("EDT")),U)
76 S @FDARR@(1204)=$$WHOSIGNS^TIULC1(TIUDA)
77 S @FDARR@(1208)=$$WHOCOSIG^TIULC1(TIUDA)
78 D FILE^DIE(FLAGS,"FDA","TIUMSG")
79 I +$P($G(^TIU(8925,+TIUDA,12)),U,4)'=+$P($G(^(12)),U,9) D
80 . S @FDARR@(1506)=1 D FILE^DIE(FLAGS,"FDA","TIUMSG")
81 D RELEASE^TIUT(TIUDA,1)
82 D AUDIT^TIUEDI1(TIUDA,0,$$CHKSUM^TIULC("^TIU(8925,"_+TIUDA_",""TEXT"")"))
83 Q
84FIX ; Filing error resolution code for Operation Reports
85 N TIUOUT,TIUDA,TIUD0,TIUX,TIUPRM0,TIUPRM1,SUCCESS,TIUBUF,TIUHIT
86 N TIUADD,TIUTYP,TIU,DUOUT,DTOUT
87 S TIUHIT=0
88 ; -- first, determine the correct TIU DOCUMENT record --
89 F D Q:$D(DUOUT)!$D(DIROUT)!+$G(TIUOUT)
90 . N D,D0,DK,DL,DIC,X,Y,DA,DX,A,S,TIUFPRIV
91 . S X=+$$PATIENT^TIULA
92 . I X'>0 D Q
93 . . W !!,"Okay, no harm done...",!
94 . . I $$READ^TIUU("EA","Press RETURN to continue...") ; pause
95 . . S TIUOUT=1
96 . S DIC=8925,DIC(0)="UXEV",D="C"
97 . W !
98 . S DIC("W")="D DICW^TIUPUTS(+Y)"
99 . S DIC("S")="I +$$DICS^TIUPUTS(+Y)"
100 . D IX^DIC
101 . I +Y'>0 D Q
102 . . W !!,$S(+$O(^TIU(8925,"C",+X,0))'>0:"No OPERATION REPORTS Available to Update.",1:"No OPERATION REPORT Selected..."),!
103 . . I $$READ^TIUU("EA","Press RETURN to continue...") ; pause
104 . . S TIUOUT=1
105 . W ! S (DA,TIUHIT)=+Y D EN^DIQ
106 . S TIUOUT=$$READ^TIUU("Y","... OK","YES") W !
107 . I +TIUOUT S TIUDA=DA
108 Q:$D(DUOUT)!$D(DIROUT)!+$G(DTOUT)!'+$G(TIUDA)
109 ; -- next, load fields from upload buffer entry --
110 S TIUBUF=$S(+$G(XQADATA):+$G(XQADATA),+$G(BUFDA):+$G(BUFDA),1:"")
111 ; -- if TIUDA may be edited, file data, else make addendum --
112 S TIUD0=$G(^TIU(8925,TIUDA,0)),TIUTYP=+TIUD0
113 I +$$CANEDIT(TIUDA)'>0 D G FIXX
114 . W !!,"Existing document may not be edited...Creating Addendum.",!
115 . D MAKEADD^TIUPEFIX(.TIUADD,TIUDA,TIUBUF)
116 . S SUCCESS=TIUADD
117 ; -- Load the array TIUX from the buffer
118 D LOADTIUX^TIUPEFIX(.TIUX,TIUBUF)
119 ; -- finally, file data in TIU DOCUMENT file --
120 K ^TIU(8925,+TIUDA,"TEMP"),TIUX(.001),TIUX(.01),TIUX(.02),TIUX(.03),TIUX(.05)
121 K TIUX(.13),TIUX(1205),TIUX(1211),TIUX(1405)
122 M ^TIU(8925,+TIUDA,"TEMP")=TIUX("TEXT") K TIUX("TEXT")
123 D FILE^TIUPEFIX(.SUCCESS,+TIUDA,.TIUX,TIUTYP)
124 D GETTIU^TIULD(.TIU,TIUDA)
125 D MERGTEXT^TIUEDI1(+TIUDA,.TIU) K ^TIU(8925,TIUDA,"TEMP")
126 S TIUPOST=$$POSTFILE^TIULC1(TIUTYP)
127 S TIUREC("#")=TIUDA
128 I TIUPOST]"" X TIUPOST
129FIXX D ALERTDEL^TIUPEVNT(+TIUBUF)
130 D RESOLVE^TIUPEVNT($S($D(XQADATA):+$P(XQADATA,";",3),1:$G(ERRDA)),1)
131 D BUFPURGE^TIUPUTC(+TIUBUF)
132 W "Done."
133 S TIUDONE=1
134 Q
135DICW(TIUDA) ; Write identifiers
136 ;VMP OIFO BAY PINES;ELR;TIU*1.0*195;MODIFIED THIS TAG
137 N X,Y,VADM,VA,VAERR,TIUD0,TIUD12,TIUD13,TIUD14,TIUPRNM
138 S TIUD0=$G(^TIU(8925,+TIUDA,0)),TIUD12=$G(^(12)),TIUD13=$G(^(13)),TIUD14=$G(^(14))
139 W ?35,"Dated: ",$$DATE^TIULS(+TIUD13,"MM/DD/CCYY@HR:MIN"),?62,"By: ",$E($$NAME^TIULS($$PERSNAME^TIULC1(+$P(TIUD12,U,2)),"LAST,FI MI"),1,13)
140 ;VMP OIFO BAY PINES;ELR;TIU*1.0*195;ADDED FROM HERE DOWN
141 Q:$G(TIUCLASS)'=38
142 S TIUD14=+$P(TIUD14,U,5)
143 Q:$L(TIUD14)'>0
144 D ONE^SROESTV(.TIUPRNM,TIUD14) ;IA 3533
145 N TIUS0 S TIUS0=$G(@TIUPRNM@(TIUD14))
146 Q:$L(TIUS0)'>0
147 W !?11,"Case #: ",TIUD14," ",$P(@TIUPRNM@(TIUD14),U,2)
148 Q
149DICS(TIUDA) ; Filter IX^DIC list
150 N TIUD0,TIUY S TIUY=0
151 S TIUD0=$G(^TIU(8925,TIUDA,0))
152 I +$$ISA^TIULX(+TIUD0,+$$CLASS^TIUSROI("OPERATION REPORTS")) S TIUY=1 I 1
153 E I +$$ISA^TIULX(+TIUD0,+$$CLASS^TIUSROI("PROCEDURE REPORT (NON-O.R.)")) S TIUY=1
154 Q TIUY
Note: See TracBrowser for help on using the repository browser.