1 | TIUHL7U2 ; SLC/AJB - TIUHL7 Utilities; March 23, 2005
|
---|
2 | ;;1.0;TEXT INTEGRATION UTILITIES;**200**;Jun 20, 1997
|
---|
3 | Q
|
---|
4 | MAKEADD(TIUDADD,TIUDA,TIUX,SUPPRESS) ; Create addendum
|
---|
5 | N DIE,DR,DA,DIC,X,Y,DLAYGO,TIUATYP,TIUCAN,TIUFPRIV,TIU S TIUFPRIV=1
|
---|
6 | N PTIEN,SUCCESS
|
---|
7 | S TIUCAN=$$CANDO^TIULP(TIUDA,"MAKE ADDENDUM",$G(PERSON))
|
---|
8 | I TIUCAN'>0 S TIUDADD=TIUCAN Q
|
---|
9 | S TIUATYP=+$$WHATITLE^TIUPUTU("ADDENDUM")
|
---|
10 | S (DIC,DLAYGO)=8925,DIC(0)="L",X=""""_"`"_TIUATYP_""""
|
---|
11 | D ^DIC
|
---|
12 | S TIUDADD=+Y
|
---|
13 | I +Y'>0 S TIUDADD=TIUDADD_"^Could not create addendum." Q
|
---|
14 | D GETTIU^TIULD(.TIU,TIUDA)
|
---|
15 | S TIU("DOCTYP")=TIUATYP_U_$$PNAME^TIULC1(TIUATYP)
|
---|
16 | S PTIEN=$P(^TIU(8925,TIUDA,0),U,2)
|
---|
17 | D STUFREC^TIUSRVP1(+TIUDADD,.TIUX,PTIEN,+$G(TIUDA),TIUATYP,.TIU)
|
---|
18 | K ^TIU(8925,+TIUDADD,"TEMP")
|
---|
19 | M ^TIU(8925,+TIUDADD,"TEMP")=TIUX("TEXT") K TIUX("TEXT")
|
---|
20 | D SETXT0^TIUSRVP(+TIUDADD)
|
---|
21 | D FILE^TIUSRVP(.SUCCESS,+TIUDADD,.TIUX,+$G(SUPPRESS))
|
---|
22 | I +SUCCESS'>0 D DIK^TIURB2(TIUDADD) S TIUDADD="-1^Could not create addendum." Q
|
---|
23 | I +$O(^TIU(8925,+TIUDADD,"TEMP",0)) D MERGTEXT^TIUEDI1(+TIUDADD,.TIU)
|
---|
24 | I '+$G(SUPPRESS) D RELEASE^TIUT(+TIUDADD,1)
|
---|
25 | K ^TIU(8925,+TIUDADD,"TEMP")
|
---|
26 | Q
|
---|
27 | DOCPRM(TIUTYP,TIUDPRM,TIUDA) ; Get Document Parameters, support inheritance
|
---|
28 | N TIUI,TIUDAD
|
---|
29 | S (TIUDPRM(0),TIUDPRM(5))=""
|
---|
30 | I $P($G(^TIU(8925.1,+TIUTYP,0)),U)["ADDENDUM",+$G(TIUDA) S TIUTYP=+$G(^TIU(8925,+$P($G(^TIU(8925,+TIUDA,0)),U,6),0))
|
---|
31 | S TIUI=+$O(^TIU(8925.95,"B",+TIUTYP,0))
|
---|
32 | I +TIUI D Q
|
---|
33 | . S TIUDPRM(0)=$G(^TIU(8925.95,+TIUI,0))
|
---|
34 | . I +$O(^TIU(8925.95,+TIUI,5,0)) D
|
---|
35 | . . N TIUJ S TIUJ=0
|
---|
36 | . . F S TIUJ=$O(^TIU(8925.95,+TIUI,5,TIUJ)) Q:+TIUJ'>0 D
|
---|
37 | . . . S $P(TIUDPRM(5),U,TIUJ)=+$G(^TIU(8925.95,+TIUI,5,+TIUJ,0))
|
---|
38 | . . S TIUJ=0
|
---|
39 | . . F S TIUJ=$O(^TIU(8925.95,+TIUI,4,TIUJ)) Q:+TIUJ'>0 D
|
---|
40 | . . . S $P(TIUDPRM(4),U,TIUJ)=+$G(^TIU(8925.95,+TIUI,4,+TIUJ,0))
|
---|
41 | S TIUDAD=$O(^TIU(8925.1,"AD",+TIUTYP,0))
|
---|
42 | I +TIUDAD D DOCPRM(TIUDAD,.TIUDPRM)
|
---|
43 | Q
|
---|
44 | ES(DA,TIUES,TIUI,TIUESIG) ; ^DIE call for /es/
|
---|
45 | N SIGNER,DR,DIE,ESDT,TIUSTAT,TIUSTNOW,COSIGNER,SVCHIEF,CSREQ,TIUPRINT
|
---|
46 | N CSNEED,TIUTTL,TIUPSIG,TIUDPRM,DAO,TIUSTWAS,TIUSTIS,DAORIG,TIUCHNG
|
---|
47 | S TIUSTWAS=$P($G(^TIU(8925,DA,0)),U,5) S:'+$G(TIUESIG) TIUESIG=DUZ
|
---|
48 | D DOCPRM^TIULC1(+$G(^TIU(8925,+DA,0)),.TIUDPRM,DA)
|
---|
49 | S TIUSTAT=$P($G(^TIU(8925,+DA,0)),U,5),ESDT=$$NOW^TIULC
|
---|
50 | S SVCHIEF=+$$ISA^USRLM(TIUESIG,"CLINICAL SERVICE CHIEF")
|
---|
51 | S SIGNER=$P(^TIU(8925,+DA,12),U,4),COSIGNER=$P(^(12),U,8),CSREQ=0
|
---|
52 | S CSNEED=+$P($G(^TIU(8925,+DA,15)),U,6)
|
---|
53 | I +CSNEED,(TIUESIG'=COSIGNER),'+$G(SVCHIEF),(TIUSTAT'=6) S CSREQ=1
|
---|
54 | I TIUSTAT=5 D
|
---|
55 | . S DR=".05////"_$S(+CSREQ:6,1:7)_";1501////"_ESDT_";1502////"_+TIUESIG
|
---|
56 | . I '+$G(CSREQ),+CSNEED,$S(TIUESIG=COSIGNER:1,+$G(SVCHIEF):1,1:0) D
|
---|
57 | . . S DR=DR_";1506////0;1507////"_ESDT_";1508////"_+TIUESIG_";1509///^S X=$P(TIUES,U,2);1510///^S X=$P(TIUES,U,3);1511////E"
|
---|
58 | I TIUSTAT=6 S DR=".05////7;1506////0;1507////"_ESDT_";1508////"_+TIUESIG
|
---|
59 | Q:'$D(DR)
|
---|
60 | S DIE=8925 D ^DIE W:'$D(XWBOS) "."
|
---|
61 | I TIUSTAT=5 S DR="1503///^S X=$P(TIUES,U,2);1504///^S X=$P(TIUES,U,3);1505////E"
|
---|
62 | I TIUSTAT=6 D
|
---|
63 | . N TIUSBY S DR="",TIUSBY=$P($G(^TIU(8925,+DA,15)),U,2)
|
---|
64 | . I +TIUSBY>0 S DR="1503///^S X=$$SIGNAME^TIULS("_TIUSBY_");1504///^S X=$$SIGTITL^TIULS("_TIUSBY_");"
|
---|
65 | . S DR=$G(DR)_"1509///^S X=$P(TIUES,U,2);1510///^S X=$P(TIUES,U,3);1511////E"
|
---|
66 | S DIE=8925 D ^DIE W:'$D(XWBOS) "." S:'+$G(TIUCHNG) TIUCHNG=1
|
---|
67 | D SEND^TIUALRT(DA),SIGNIRT^TIUDIRT(+DA)
|
---|
68 | S DAORIG=DA
|
---|
69 | I +$$ISADDNDM^TIULC1(DA) S DA=+$P($G(^TIU(8925,+DA,0)),U,6)
|
---|
70 | I +$G(CSREQ)'>0 D MAIN^TIUPD(DA,"S") I 1
|
---|
71 | ;If 'Credit Stop Code on Completion' is Yes
|
---|
72 | I +$P(^TIU(8925,+DA,0),U,11) D
|
---|
73 | . ;If workload does not exist, process using TIU's interview otherwise
|
---|
74 | . ;process as an edit using PCE's interview
|
---|
75 | . I '$$CHKVST^TIUPXAP2(+DA) D I 1
|
---|
76 | . . N TIUCONT,TIUPRMT
|
---|
77 | . . Q:$D(XWBOS)
|
---|
78 | . . I $P(+$P(^TIU(8925,+DA,0),U,7),".")>DT D Q
|
---|
79 | . . . W !!
|
---|
80 | . . . D QUE^TIUPXAP1
|
---|
81 | . . . W:$$READ^TIUU("EA","Press RETURN to continue...") ""
|
---|
82 | . . W !!
|
---|
83 | . . ;Check if workload should be entered
|
---|
84 | . . I $$CHKWKL^TIUPXAP2(+DA,.TIUDPRM) D CREDIT^TIUVSIT(DA)
|
---|
85 | . E D
|
---|
86 | . . ;Check if workload should be entered
|
---|
87 | . . I $$CHKWKL^TIUPXAP2(+DA,.TIUDPRM) D EDTENC^TIUPXAP2(DA)
|
---|
88 | . D REMFLAG^TIUVSIT(+DA)
|
---|
89 | ;If document does not have a visit and docmt is associated with
|
---|
90 | ;an event type visit or call is invoked by broker, check if
|
---|
91 | ;docmt can be linked to an existing visit or try and create a new
|
---|
92 | ;visit. (P179)
|
---|
93 | I $D(^TIU(8925,+DA,0)),$P(^(0),U,3)'>0,($P(^(0),U,13)="E"!($$BROKER^XWBLIB)) D
|
---|
94 | . N D0,DFN,TIU,TIUVSIT
|
---|
95 | . ;Try to link docmt to an existing visit, quit if successful
|
---|
96 | . I $$LNKVST^TIUPXAP3(DA,.TIUVSIT) Q
|
---|
97 | . ;Otherwise set TIU array and DFN to use TIU API which calls PCE
|
---|
98 | . ;to resolve multiple visits or creates a new visit
|
---|
99 | . D GETTIU^TIULD(.TIU,DA)
|
---|
100 | . S DFN=$P($G(^TIU(8925,+DA,0)),U,2)
|
---|
101 | . D QUE^TIUPXAP1
|
---|
102 | ; post-signature action
|
---|
103 | N TIUCONS S TIUCONS=-1
|
---|
104 | D ISCNSLT^TIUCNSLT(.TIUCONS,+$G(^TIU(8925,DA,0)))
|
---|
105 | I TIUCONS S DA=DAORIG
|
---|
106 | S TIUSTIS=$P($G(^TIU(8925,DA,0)),U,5)
|
---|
107 | S TIUTTL=+$G(^TIU(8925,+DA,0)),TIUPSIG=$$POSTSIGN^TIULC1(TIUTTL)
|
---|
108 | I +$L(TIUPSIG),'+$G(CSREQ) X TIUPSIG
|
---|
109 | I TIUCONS,TIUSTIS=7,TIUSTWAS<7,$$HASKIDS^TIUSRVLI(DA) D
|
---|
110 | . N SEQUENCE,TIUKIDS,TIUINT,TIUK
|
---|
111 | . S SEQUENCE="D",TIUKIDS="TIUKIDS",TIUINT=0,TIUK=0
|
---|
112 | . D SETKIDS^TIUSRVLI(TIUKIDS,DA,TIUINT)
|
---|
113 | . F S TIUK=$O(TIUKIDS(TIUK)) Q:'TIUK D
|
---|
114 | . . I $P(TIUKIDS(TIUK),U,7)="completed" X TIUPSIG
|
---|
115 | Q
|
---|
116 | STRIP(X) ; Strip control characters
|
---|
117 | N I,Y
|
---|
118 | ; First replace TABS w/5 spaces
|
---|
119 | F I=1:1:$L(X) S:$A(X,I)=9 X=$E(X,1,(I-1))_" "_$E(X,(I+1),$L(X))
|
---|
120 | ; Next, remove control characters
|
---|
121 | S Y="" F I=1:1:$L(X) S:$A(X,I)>31 Y=Y_$E(X,I)
|
---|
122 | Q Y
|
---|