source: WorldVistAEHR/trunk/r/CLINICAL_PROCEDURES-MD/MDRPCOW.m@ 893

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

initial load of WorldVistAEHR
File size: 5.9 KB
RevLine 
[613]1MDRPCOW ; HOIFO/DP/NCA - Billing Widget ;10/3/05 12:17
2 ;;1.0;CLINICAL PROCEDURES;**6**;Apr 01, 2004;Build 102
3 ; Reference IA# 2240 [Supported] ENCRYP^XUSRB1 call
4 ; 2241 [Supported] DECRYP^XUSRB1 call
5 ; 10017 [Supported] ^DD("DD") reference
6 ; 10040 [Supported] Hospital Location File Access
7 ; 10045 [Supported] XUSHSHP call
8 ; 10060 [Supported] FILE 200 references
9 ;
10RPC(RESULTS,OPTION,P1,P2,P3,P4,P5,P6,P7) ; [Procedure] Main RPC call
11 ; RPC: [MD TMDWIDGET]
12 ;
13 D CLEAN^DILF
14 S RESULTS=$NA(^TMP("MDKUTL",$J)) K @RESULTS
15 I $T(@OPTION)="" D Q
16 .S @RESULTS@(0)="-1^Error in RPC: MD TMDWIDGET at "_OPTION_U_$T(+0)
17 D @OPTION S:'$D(@RESULTS) @RESULTS@(0)="-1^No return"
18 D CLEAN^DILF
19 Q
20 ;
21SUBMIT ; Submit a final report to close out an entry in 702
22 ;
23 ; P1=702 IEN
24 ; P2=Encoded E-Sig
25 ; P3=Array containing the text for the note
26 ;
27 I '$D(^MDD(702,+P1,0)) S @RESULTS@(0)="-1^No such study" Q
28 I $P(^MDD(702,+P1,0),U,9)=2 S @RESULTS@(0)="-1^Study is in Error status, cannot use study until the error is fixed." Q
29 I "016"[$P(^MDD(702,+P1,0),U,9) S @RESULTS@(0)="-1^Cannot submit - not a Dialysis study." Q
30 I $D(P3)<1 S @RESULTS@(0)="-1^No note text" Q
31 I P2="" D PCE Q
32 K ^TMP("MDTXT",$J)
33 S X="",Y=1
34 F S X=$O(P3(X)) Q:X="" S ^TMP("MDTXT",$J,Y)=P3(X),Y=Y+1
35 ; a "1^Note Filed" if everything is ok otherwise an error msg
36 I P2'="" S P2=$$DECRYP^XUSRB1(P2),P2=$$ENCRYP^XUSRB1(P2)
37 ;S @RESULTS@(0)=$$SUBMIT^MDRPCOT2(+P1,P2,$NA(^TMP("MDTXT",$J)),.P7)
38 S @RESULTS@(0)=$$SUBMIT^MDRPCOT2(+P1,P2,$NA(^TMP("MDTXT",$J)))
39 I +@RESULTS@(0)>0 S @RESULTS@(0)="1^Approval Message"
40 N XX S XX="",XX=$$UPDCONS^MDRPCOT1(+$P($G(^MDD(702,+P1,0)),U,5),+$P($G(^MDD(702,+P1,0)),U,6))
41 ;
42 K ^TMP("MDTXT",$J) Q
43 Q
44 ;
45ESIG ; [Procedure] Verify users electronic signature
46 I $G(P1)="" D Q
47 .S @RESULTS@(0)="-1^Must supply electronic signature code"
48 S X=$$DECRYP^XUSRB1(P1)
49 D HASH^XUSHSHP
50 I X'=$$GET1^DIQ(200,DUZ_",",20.4,"I") S @RESULTS@(0)="-1^E-Sig Invalid^"
51 E S @RESULTS@(0)="1^E-Sig Verifed^"_X
52 Q
53 ;
54GETBILL ; Get Billing Data
55 Q
56 N MDFLD
57 ;D BLDFLD^MDXMLFM(.MDFLD,702,".001;;STUDY_ID^.01;;PATIENT_ID")
58 ;D BLDFLD^MDXMLFM(.MDFLD,702,".14;;ICD_01^.15;;ICD_02^.16;;ICD_03^.17;;ICD_04^.18;;CPT_01")
59 ;D BLDFLD^MDXMLFM(.MDFLD,702,".19;;SC_CONDITION^.2;;MST^.21;;AO_EXPOSURE^.22;;IR_EXPOSURE^.23;;EV_CONTAMINENTS^.24;;HEAD_NECK_CANCER^.25;;COMBAT_VETERAN")
60 ;D BLDFLD^MDXMLFM(.MDFLD,702,".26;;PRIMARY_PROVIDER_ID")
61 ;D BLDFLD^MDXMLFM(.MDFLD,702,".26:.01;;PRIMARY_PROVIDER_NAME")
62 ;D BLDFLD^MDXMLFM(.MDFLD,702,".27;;ATTENDING_PROVIDER_ID")
63 ;D BLDFLD^MDXMLFM(.MDFLD,702,".27:.01;;ATTENDING_PROVIDER_NAME")
64 ;D LOADONE^MDXMLFM(P1,702,.MDFLD)
65 Q
66 ;
67SETBILL ; Set Billing Data
68 N MDFDA,MDERR
69 ;F X=0:1:13 S P2(X)=$G(P2(X)) D
70 ;.D VAL^DIE(702,+P1_",",.14+(X*.01),"F",P2(X),.MDERR,"MDFDA")
71 ;.Q:MDERR'="^" ; Validated
72 ;.S Y="Bad value: "_$$GET1^DID(702,.14+(X*.01),,"LABEL")_" '"_P2(X)_"'"
73 ;.S @RESULTS@($O(@RESULTS@(""),-1)+1)=Y
74 ;I $D(@RESULTS) S @RESULTS@(0)="-1^Errors filing data" Q
75 ;D FILE^DIE("","MDFDA")
76 S @RESULTS@(0)="1^Ok"
77 Q
78 ;
79PCE ; Set PCE Data
80 ;
81 ; P1=702 IEN
82 ; P2=Encoded E-Sig
83 ; P3=Array containing the text for the note
84 ; P7=Array of Billing information
85 ;
86 N CTR,DFN,MDCON,MDFDA,MDGST,MDL,MDLOC,MDNOTE,MDPDT,MDPROC,MDRESU,MDTITL,MDTSTR,MDVST,MDVSTR,MDWP S CTR=0,MDGST=+P1,MDRESU=""
87 I '$D(^MDD(702,+P1,0)) S @RESULTS@(0)="-1^No such study" Q
88 ;
89 ; Get data to set PCE data
90 S (MDTSTR,MDRESU)=$$GETDATA^MDRPCOT2(MDGST)
91 ; File Error message
92 I +MDRESU<0 S @RESULTS@(0)=MDRESU Q
93 I $G(MDTSTR)="" S @RESULTS@(0)="-1^No Data in study to set PCE data." Q
94 F MDL="DFN","MDTITL","MDLOC","MDNOTE","MDCON","MDPROC","MDVSTR","MDNVST" D
95 .S CTR=CTR+1,@MDL=$P(MDTSTR,"^",CTR)
96 S (MDVST,MDRESU)=""
97 I 'MDLOC S @RESULTS@(0)="-1^No Hospital Location." Q
98 ; Create new visit, if no vstring
99 S MDPDT=$$PDT^MDRPCOT1(MDGST)
100 S:'MDPDT MDPDT=$P(MDVSTR,";",2) ; If No D/T Performed grab visit D/T
101 ; File PCE Error message
102 I MDNVST S MDRESU=$$EN1^MDPCE2(.P7,MDGST,$P(MDVSTR,";",2),MDPROC,$P(MDVSTR,";",3),"P",MDLOC) I +MDRESU S MDVST=+MDRESU
103 I 'MDNVST S MDVST=$P($G(^MDD(702,+MDGST,1)),U) S MDRESU=$$EN1^MDPCE2(.P7,MDGST,$P(MDVSTR,";",2),MDPROC,$P(MDVSTR,";",3),"P",MDLOC) I +MDRESU S MDVST=+MDRESU
104 I +MDRESU<0 S @RESULTS@(0)=MDRESU Q
105 ;
106 S @RESULTS@(0)="Approval Message"
107 Q
108GETLOC ; Get the existing hospital location
109 N MDCL,MDPR,MDVV
110 S MDPR=$P($G(^MDD(702,+P1,0)),U,4)
111 S MDVV=$P($G(^MDD(702,+P1,0)),U,7)
112 ;S MDCL=$$GET1^DIQ(702.01,+MDPR_",",.05,"I")
113 S MDCL=$P(MDVV,";",3)
114 I 'MDCL S MDCL=$$GET1^DIQ(702.01,+MDPR_",",.05,"I")
115 I 'MDCL S @RESULTS@(0)="-1^No Hospital Location." Q
116 S Y=$P(MDVV,";",2) I Y'="" X ^DD("DD")
117 S @RESULTS@(0)=MDCL_U_$$GET1^DIQ(44,MDCL_",",.01,"I")_U_Y
118 Q
119SETLOC ; Set a new clinic location from GUI if non is found.
120 N MDVV
121 S MDVV=$P($G(^MDD(702,+P1,0)),U,7)
122 I P2="" S @RESULTS@(0)="-1^No Location Selected."
123 I $L(MDVV,";")=1 S MDVV=";"_MDVV
124 S $P(MDVV,";",3)=P2
125 S $P(^MDD(702,P1,0),U,7)=MDVV
126 S @RESULTS@(0)="1^Okay Location Updated."
127 Q
128CHECK ; return TRUE if PCE data filled
129 N MDIL,MDOKAY,MDCK,MDECTR
130 S (MDECTR,MDIL)=0,MDCK="",MDOKAY("POV")="",MDOKAY("CPT")="",MDOKAY("PRV")=""
131 F S MDIL=$O(@P2@(MDIL)) Q:MDIL="" S MDCK=$G(@P2@(MDIL)) D
132 . I $P(MDCK,U,1)="POV" S:$G(MDOKAY("POV"))="" MDOKAY("POV")=1
133 . I $P(MDCK,U,1)="CPT" S:$G(MDOKAY("CPT"))="" MDOKAY("CPT")=1
134 . I $P(MDCK,U,1)="PRV" S:$G(MDOKAY("PRV"))="" MDOKAY("PRV")=1
135 F MDIL="POV","PRV","CPT" S MDECTR=MDECTR+$G(MDOKAY(MDIL))
136 I MDECTR<3 S @RESULTS@(0)="-1^Missing PCE data--Review Data Again." Q
137 S @RESULTS@(0)=1
138 Q
139NAME ; Get the person name
140 S @RESULTS@(0)="1^"_$$GET1^DIQ(200,+P2_",",.01,"E")
141 Q
142STAT ; Get the okay status of the CP study
143 N MDST,MDGN S MDGN=""
144 S MDST=$$GET1^DIQ(702,+P1,.09,"E") S MDGN=MDST
145 I $$GET1^DIQ(702,+P1,.09,"I")=2 S MDGN=MDGN_"^"_$$GET1^DIQ(702,+P1,.08,"E")
146 S @RESULTS@(0)=MDGN
147 Q
148STATUS ; [Procedure] Update transaction status
149 N MDFDA
150 S MDFDA(702,+P1_",",.09)=P2
151 D FILE^DIE("","MDFDA")
152 S @RESULTS@(0)="1^Done"
153 Q
Note: See TracBrowser for help on using the repository browser.