source: FOIAVistA/trunk/r/CARE_MANAGEMENT-ORRC/ORRCTIU.m@ 1397

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

initial load of FOIAVistA 6/30/08 version
File size: 6.1 KB
Line 
1ORRCTIU ; SLC/JER - TIU data for CM ; 7/18/05 10:38
2 ;;1.0;CARE MANAGEMENT;**2**;Jul 15, 2003
3 ;
4 ; This routine invokes IAs: 2322,2323,2834,2937,2944,2960,4175,4733
5 ;
6GETPTUNS(ORRCY,AUDUZ) ; Get pts w/documents that need user's signature
7 ; Returns @ORRCY@(DFN,"DOC:"_TIUDA)=""
8 ; [from ORRCDPT]
9 N TITLE,GVN,ORT,TIUDA,ORDFN,ITR,ORRCASIG
10 S TITLE=0,GVN=$NA(^TIU(8925,"AAU")),ORRCY=$NA(^TMP($J,"ORRCTIU")) K @ORRCY
11 F S TITLE=$O(@GVN@(AUDUZ,TITLE)) Q:+TITLE'>0 D
12 . S ORT=0 F S ORT=$O(@GVN@(AUDUZ,TITLE,5,ORT)) Q:+ORT'>0 D
13 .. S TIUDA=0
14 .. F S TIUDA=$O(@GVN@(AUDUZ,TITLE,5,ORT,TIUDA)) Q:+TIUDA'>0 D
15 ... S ORDFN=$P($G(^TIU(8925,TIUDA,0)),U,2) Q:+ORDFN'>0
16 ... I $D(^TMP($J,"ORRCLST")),'$D(^TMP($J,"ORRCY",ORDFN)) Q ;not on list
17 ... I '+$$CANDO^TIULP(TIUDA,"SIGNATURE",AUDUZ) Q ; user may not sign
18 ... S @ORRCY@(ORDFN,"DOC:"_TIUDA)=""
19 S TITLE=0,GVN=$NA(^TIU(8925,"ASUP"))
20 F S TITLE=$O(@GVN@(AUDUZ,TITLE)) Q:+TITLE'>0 D
21 . N STATUS F STATUS=5,6 D
22 .. S ORT=0 F S ORT=$O(@GVN@(AUDUZ,TITLE,STATUS,ORT)) Q:+ORT'>0 D
23 ... S TIUDA=0
24 ... F S TIUDA=$O(@GVN@(AUDUZ,TITLE,STATUS,ORT,TIUDA)) Q:+TIUDA'>0 D
25 .... S ORDFN=$P($G(^TIU(8925,TIUDA,0)),U,2) Q:+ORDFN'>0
26 .... I $D(^TMP($J,"ORRCLST")),'$D(^TMP($J,"ORRCY",ORDFN)) Q ;not on list
27 .... I '+$$CANDO^TIULP(TIUDA,$S(STATUS=5:"SIGNATURE",1:"COSIGNATURE"),AUDUZ) Q ; user may not Sign/Cosign
28 .... S @ORRCY@(ORDFN,"DOC:"_TIUDA)=""
29 ; capture addl signer docs
30 K ^TMP("TIUSIGN",$J),^TMP("ORRCASIG",$J)
31 S ORRCASIG="",ITR=0
32 D NEEDSIG^TIULX(.ORRCASIG,AUDUZ)
33 Q:'$D(@ORRCASIG)
34 M ^TMP("ORRCASIG",$J)=@ORRCASIG
35 F S ITR=$O(^TMP("ORRCASIG",$J,ITR)) Q:'ITR D
36 . S TIUDA=^TMP("ORRCASIG",$J,ITR)
37 . S ORDFN=$P($G(^TIU(8925,TIUDA,0)),U,2) Q:+ORDFN'>0
38 . I $D(^TMP($J,"ORRCLST")),'$D(^TMP($J,"ORRCY",ORDFN)) Q ;not on list?
39 . I '+$$CANDO^TIULP(TIUDA,"SIGNATURE",AUDUZ) Q ; user may not sign
40 . S @ORRCY@(ORDFN,"DOC:"_TIUDA)=""
41 K ^TMP("TIUSIGN",$J),^TMP("ORRCASIG",$J)
42 Q
43 ;
44LISTUNS(ORY,ORUSR,ORPAT) ; -- Get list of unsigned documents for ORPAT by ORUSR
45 ;
46 Q
47 ;
48TEXT(ORY,DOC) ; -- Return text of DOCs in
49 ; @ORY@(#) = Item=ID^Title^Date IN HL7 format
50 ; = Text=line of document text
51 N ORN,ORI,ORRCY,TIUDA,TIUY,TIUI,TIUX
52 S ORN=0,ORY=$NA(^TMP($J,"ORRCDOC")) K @ORY
53 S ORI="" F S ORI=$O(DOC(ORI)) Q:ORI="" D
54 . S TIUDA=+$P(DOC(ORI),":",2) D TGET^TIUSRVR1(.ORRCY,TIUDA)
55 . M TIUY=ORRCY
56 . S TIUX=$$RESOLVE^TIUSRVLO(TIUDA)
57 . S ORN=ORN+1,@ORY@(ORN)="Item=DOC:"_TIUDA_U_$P(TIUX,U)_U_$P($$FMTHL7^XLFDT($P(TIUX,U,2)),"-")_U_$$REQENC(TIUDA)
58 . S TIUI=0 F S TIUI=$O(@TIUY@(TIUI)) Q:TIUI<1 S ORN=ORN+1,@ORY@(ORN)="Text="_@TIUY@(TIUI)
59 Q
60 ;
61REQENC(TIUDA) ; -- Determine whether encounter data is needed
62 N ORRD0,ORRD12,ORSVC,ORRY,ORRDP,ORRCSA,ORASK,ORRPRIMD,DATANEED,ORROPT,LST,ORRPRIME,ORRCLST,ORRCDP,ORRCASK
63 S ORRD0=$G(^TIU(8925,TIUDA,0)),ORRD12=$G(^(12)),ORRY="false"
64 S (ORROPT,DATANEED)=0
65 ; Load existing encounter info
66 D PCE4NOTE^ORWPCE3(.ORRCLST,TIUDA,+$P(ORRD0,U,2))
67 ; identify primary provider
68 S ORRPRIMD=$$GETPRIMD(TIUDA,ORRD12,.ORRCLST)
69 M LST=ORRCLST
70 ; determine whether "Data Needed"
71 ; 1. if encdt > today quit false
72 I +$P(ORRD0,U,7)>(DT_".235959") G CHKASK
73 ; 2. if service category '= "A", "I", or "T" quit false
74 S ORSVC=$P(ORRD0,U,13)
75 I '$S(ORSVC="A":1,ORSVC="I":1,ORSVC="T":1,1:0) G CHKASK
76 S ORROPT=1
77 ; if TIU doc param SUPPRESS DX/CPT ON ENTRY is true, quit false
78 D DOCPRM^TIULC1(+ORRD0,.ORRCDP)
79 M ORRDP=ORRCDP
80 I +$P(ORRDP(0),U,14) G CHKASK
81 ; if stand-alone visit, quit true
82 D HASVISIT^ORWPCE(.ORRCSA,TIUDA,+$P(ORRD0,U,2),+$P(ORRD12,U,11),+$P(ORRD0,U,7))
83 I ORRCSA<1 S DATANEED=1 G CHKASK
84 ; if TIU doc param ASK DX/CPT ON ALL OPT VISITS is true, quit true
85 I +$P(ORRDP(0),U,16) S DATANEED=1 G CHKASK
86CHKASK I +DATANEED S DATANEED=$$CHKPCE(TIUDA,.ORRCLST,$P(ORRD0,U,2),$P(ORRD12,U,11))
87 M LST=ORRCLST
88 D ASKPCE^ORWPCE2(.ORRCASK,DUZ,+$P(ORRD12,U,11))
89 M ORASK=ORRCASK
90 ; if Never or Disable, quit false
91 I $S(ORASK=6:1,ORASK=7:1,1:0) S ORRY="false" G REQENCX
92 ; if Always, quit true
93 I ORASK=5 S ORRY="true" G REQENCX
94 ; if Data Needed, quit true
95 I ORASK=3,+DATANEED S ORRY="true" G REQENCX
96 ; if Outpatient, quit true
97 I ORASK=4,+ORROPT S ORRY="true" G REQENCX
98 ; If we don't know who the primary encounter provider is, and we need to know, we
99 ; must go to the chart to sign the note - so we treat it the same as if they are primary
100 I ORRPRIMD=0 S ORRPRIME=1
101 E S ORRPRIME=+(DUZ=ORRPRIMD)
102 ; if Primary/Data Needed, quit true
103 I ORASK=0,ORRPRIME,+DATANEED S ORRY="true" G REQENCX
104 ; if Primary/Outpatient, quit true
105 I ORASK=1,ORRPRIME,+ORROPT S ORRY="true" G REQENCX
106 ; if Primary Always, quit true
107 I ORASK=2,ORRPRIME S ORRY="true" G REQENCX
108REQENCX Q ORRY
109 ;
110CHKPCE(TIUDA,LST,PTNT,LOC) ; Look for existing PCE data
111 N ENCDT,ORI,CPT,COUNT,MAX,ICD,CODE,SUB,EXPNEED,EXP,RESULT,SCREQ,DOCPARM
112 N ORRCSREQ,ORRCDOCP
113 S (CPT,ICD,ORI,EXPNEED,EXP,RESULT,COUNT)=0
114 S MAX=2
115 S ENCDT=$P($P(LST(1),U,4),";",2)
116 D SCSEL^ORWPCE(.ORRCSREQ,PTNT,ENCDT,LOC,"")
117 M SCREQ=ORRCSREQ
118 D DOCPARM^TIUSRVP1(.ORRCDOCP,TIUDA,0)
119 M DOCPARM=ORRCDOCP
120 I +$P(DOCPARM(0),U,15)=1 S EXPNEED=1,MAX=8
121 F S ORI=$O(LST(ORI)) Q:+ORI'>0 D Q:(COUNT'<MAX)
122 . S CODE=$P(LST(ORI),U)
123 . I CODE="POV",'ICD S ICD=1,COUNT=COUNT+1
124 . I CODE="CPT",'CPT S CPT=1,COUNT=COUNT+1
125 . I EXPNEED,CODE="VST" D
126 . . N VAL,IDX
127 . . S SUB=$P(LST(ORI),U,2),VAL=$P(LST(ORI),U,3)
128 . . S IDX=$S(SUB="SC":1,SUB="AO":2,SUB="IR":3,SUB="EC":4,SUB="MST":5,SUB="HNC":6,1:0)
129 . . I IDX>0 S COUNT=COUNT+1 I VAL'="" S $P(SCREQ,";",IDX)=0
130 I 'ICD Q 1
131 I 'CPT Q 1
132 F ORI=1:1:6 D Q:RESULT=1
133 . I $P($P(SCREQ,";",ORI),U,1) S RESULT=1
134 Q RESULT
135GETPRIMD(TIUDA,ORRD12,LST) ; Get the Primary Provider
136 N ORRY,ORI,ORMDEF,TIUSPRM,ORRCSPRM
137 S (ORI,ORRY)=0
138 D SITEPARM^TIUSRVP1(.ORRCSPRM) M TIUSPRM=ORRCSPRM
139 ; 1. Check for the provider in the encounter, if it exists.
140 F S ORI=$O(LST(ORI)) Q:+ORI'>0 D Q:+ORRY
141 . I $P(LST(ORI),U)="PRV",+$P(LST(ORI),U,6) S ORRY=$P(LST(ORI),U,2)
142 ; 2. check for the default primary as specified in TIU
143 I 'ORRY D ;DEFDOC^TIUSRVP1(.ORMDEF,$P(ORRD12,U,11),DUZ,$P(ORRD0,U,7),TIUDA) S ORRY=+ORMDEF
144 . I +$P(TIUSPRM,U,8)=1 S ORRY=$$DFLTDOC^TIUPXAPI($P(ORRD12,U,11)) I +ORRY'=DUZ S ORRY=0
145 Q ORRY
146SIGN(ORY,LIST) ; -- Apply signature to documents in LIST(#)=DOC:##
147 ; RPC = ORRC UNSIGNED DOCS SIGN
148 Q
Note: See TracBrowser for help on using the repository browser.