source: FOIAVistA/trunk/r/PCE_PATIENT_CARE_ENCOUNTER-AUTN-EFDP-PX-VSIT--PXRM/VSITDEF.m@ 1245

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

initial load of FOIAVistA 6/30/08 version
File size: 6.7 KB
Line 
1VSITDEF ;ISL/dee - Defaulting Logic for the Visit ;4/17/97
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;**76,111,130,164**;Aug 12, 1996
3 ; Patch PX*1*76 changes the 2nd line of all VSIT* routines to reflect
4 ; the incorporation of the module into PCE. For historical reference,
5 ; the old (VISIT TRACKING) 2nd line is included below to reference VSIT
6 ; patches.
7 ;
8 ;;2.0;VISIT TRACKING;**1,2**;Aug 12, 1996
9 ;
10 Q ; - not an entry point
11 ;
12REQUIRED() ;Check the required variables
13 ;and Default all fields that are need for lookup matching
14 ; Returns: 0 if no errors and
15 ; 1 if there are errors that prevent processing
16 ; (stored in QUIT)
17 N QUIT,SITE
18 S QUIT=0
19 S SITE=+$$SITE^VASITE($P($G(VSIT("VDT")),"^"))
20 ; - VDT
21 S VSIT("VDT")=$$ERRCHK^VSITCK("VDT",VSIT("VDT"),$S(VSIT("SVC")="E":"TS",1:""))
22 I $L(VSIT("VDT"),"^")>1 D ERR^VSITPUT($P(VSIT("VDT"),"^",2,99)) S QUIT=1
23 ; - PAT
24 S VSIT("PAT")=$$ERRCHK^VSITCK("PAT",VSIT("PAT"))
25 I $L(VSIT("PAT"),"^")>1 D ERR^VSITPUT($P(VSIT("PAT"),"^",2,99)) S QUIT=1
26 I VSIT("INS")="",VSIT("OUT")="",VSIT("SVC")'="E" D
27 . S VSIT("INS")=$$INS4LOC^VSITCK1(+VSIT("LOC"))
28 . I VSIT("INS")']"",SITE>0 S VSIT("INS")=SITE
29 . S VSIT("INS")=$$ERRCHK^VSITCK("INS",VSIT("INS"))
30 I $L(VSIT("INS"),"^")>1 D ERR^VSITPUT($P(VSIT("INS"),"^",2,99)) S QUIT=1
31 ; - LOC
32 I (VSIT("INS")=SITE&(VSIT("SVC")'="E"))!(VSIT("LOC")]"") D
33 . S VSIT("LOC")=$$ERRCHK^VSITCK("LOC",VSIT("LOC"))
34 I $L(VSIT("LOC"),"^")>1 D ERR^VSITPUT($P(VSIT("LOC"),"^",2,99)) S QUIT=1
35 ; - TYP
36 I VSIT("TYP")']"",VSIT("INS")]"" S VSIT("TYP")="V"
37 I VSIT("TYP")']"",VSIT("SVC")="E" S VSIT("TYP")="O"
38 S:VSIT("TYP")']"" VSIT("TYP")=$G(DUZ("AG"))
39 S:VSIT("TYP")']"" VSIT("TYP")=$P($G(^DIC(150.9,1,0)),"^",3)
40 S VSIT("TYP")=$$ERRCHK^VSITCK("TYP",VSIT("TYP"))
41 I $L(VSIT("TYP"),"^")>1 D ERR^VSITPUT($P(VSIT("TYP"),"^",2,99)) S QUIT=1
42 ; - DSS
43 I VSIT("DSS")="",VSIT("LOC")]"" D
44 . S VSIT("DSS")=$$DSS4LOC^VSITCK1(+VSIT("LOC"))
45 I VSIT("DSS")]"" D
46 . S VSIT("DSS")=$$ERRCHK^VSITCK("DSS",VSIT("DSS"))
47 I $L(VSIT("DSS"),"^")>1 D ERR^VSITPUT($P(VSIT("DSS"),"^",2,99)) S QUIT=1
48 ; - IO
49 S VSIT("IO")=$S(VSITIPM>0:1,1:0)
50 ; - SVC
51 I VSIT("SVC")'="E" D
52 . I +VSIT("DSS") D
53 .. ;Default svc based on the dss id
54 .. I $P(^DIC(40.7,+VSIT("DSS"),0),"^",1)["TELE" S VSIT("SVC")="T" ;any TELEphone
55 .. E I $O(^VSIT(150.1,"B",+$P(^DIC(40.7,+VSIT("DSS"),0),"^",2),0)) S VSIT("SVC")="X"
56 .. E I VSIT("SVC")="",VSIT("DSS")=$P($G(^SC(+VSIT("LOC"),0)),"^",7) S VSIT("SVC")="A"
57 . I VSIT("SVC")="" S VSIT("SVC")="X"
58 I VSIT("IO") D
59 . I VSIT("SVC")="A" S VSIT("SVC")="I"
60 . E I VSIT("SVC")="X" S VSIT("SVC")="D"
61 E D
62 . I VSIT("SVC")="I" S VSIT("SVC")="A"
63 . E I VSIT("SVC")="D" S VSIT("SVC")="X"
64 S VSIT("SVC")=$$ERRCHK^VSITCK("SVC",VSIT("SVC"))
65 I $L(VSIT("SVC"),"^")>1 D ERR^VSITPUT($P(VSIT("SVC"),"^",2,99)) S QUIT=1
66 ;
67 Q QUIT
68 ;
69DEFAULTS ;Default all of the rest of the fields that are NOT need for lookup matching
70 ; - CDT & MDT
71 D
72 . N %,%H,%I,X
73 . D NOW^%DTC
74 . S (VSIT("CDT"),VSIT("MDT"))=%
75 ; - LNK
76 ; check if good
77 D:VSIT("LNK")]""
78 . S VSIT("LNK")=$$GET^VSITVAR("LNK",VSIT("LNK"))
79 . I +VSIT("LNK"),+VSIT("PAT") D
80 . . S NOD=$G(^AUPNVSIT(+VSIT("LNK"),0))
81 . . S:+$P(NOD,"^",11) VSIT("LNK")="" ; delete flag
82 . . S:+VSIT("PAT")'=$P(NOD,"^",5) VSIT("LNK")="" ; different patients
83 S VSIT("LNK")=$$ERRCHK^VSITCK("LNK",VSIT("LNK"))
84 D:$L(VSIT("LNK"),"^")>1 WRN^VSITPUT($P(VSIT("LNK"),"^",2,99))
85 ; - COD
86 S VSIT("COD")=$$ERRCHK^VSITCK("COD",VSIT("COD"))
87 D:$L(VSIT("COD"),"^")>1 WRN^VSITPUT($P(VSIT("COD"),"^",2,99))
88 ; - ELG
89 I +VSIT("PAT"),$F(VSIT(0),"I")!($F(VSIT(0),"E")) D
90 . S:VSIT(0)["I" VSIT("ELG")=$$ELG^VSITASK(VSIT("PAT"))
91 . D:VSIT("ELG")=""
92 . . S:VSIT("LNK")>0 VSIT("ELG")=$P($G(^AUPNVSIT(VSIT("LNK"),0)),"^",21) ;Eligibility Code form Parent Visit
93 . . S:VSIT("ELG")="" VSIT("ELG")=$P($G(^DPT(+VSIT("PAT"),.36)),"^") ;Primary Eligibility Code
94 . . D:VSIT("ELG")=""
95 . . . N VSITI,VSITE
96 . . . S (VSITI,VSITE)=0
97 . . . ;See if any eligibilities it the Patient Eigibilities sub-file
98 . . . F S VSITE=$O(^DPT(+VSIT("PAT"),"E",VSITE)) Q:VSITE'>0 S VSITI=VSITI+1
99 . . . I VSITI=1 S VSIT("ELG")=$O(^DPT(+VSIT("PAT"),"E",0)) ;If only one use it
100 S VSIT("ELG")=$$ERRCHK^VSITCK("ELG",VSIT("ELG"))
101 D:$L(VSIT("ELG"),"^")>1 WRN^VSITPUT($P(VSIT("ELG"),"^",2,99))
102 ; - USR
103 I VSIT("USR")="",+$G(DUZ) S VSIT("USR")=+DUZ
104 S VSIT("USR")=$$ERRCHK^VSITCK("USR",VSIT("USR"))
105 D:$L(VSIT("USR"),"^")>1 WRN^VSITPUT($P(VSIT("USR"),"^",2,99))
106 ; - OPT
107 S:VSIT("OPT")="" VSIT("OPT")=$P($G(XQY),"^")
108 S VSIT("OPT")=$$ERRCHK^VSITCK("OPT",VSIT("OPT"))
109 D:$L(VSIT("OPT"),"^")>1 WRN^VSITPUT($P(VSIT("OPT"),"^",2,99))
110 ; - PRO
111 I VSIT("PRO")="",$P($G(XQORNOD),";",2)="ORD(101," S VSIT("PRO")=$P($G(XQORNOD),";")
112 S VSIT("PRO")=$$ERRCHK^VSITCK("PRO",VSIT("PRO"))
113 D:$L(VSIT("PRO"),"^")>1 WRN^VSITPUT($P(VSIT("PRO"),"^",2,99))
114 ; - OUT
115 S VSIT("OUT")=$$ERRCHK^VSITCK("OUT",VSIT("OUT"))
116 D:$L(VSIT("OUT"),"^")>1 WRN^VSITPUT($P(VSIT("OUT"),"^",2,99))
117 ; - VID
118 S VSIT("VID")=$$GETVID^VSITVID
119 ; - PRI
120 I VSIT("PRI")="P",$O(^VSIT(150.1,"B",+$P($G(^DIC(40.7,+VSIT("DSS"),0)),"^",2),0)) S VSIT("PRI")="O"
121 S VSIT("PRI")=$$ERRCHK^VSITCK("PRI",VSIT("PRI"))
122 D:$L(VSIT("PRI"),"^")>1 WRN^VSITPUT($P(VSIT("PRI"),"^",2,99))
123 ; - SC
124 S VSIT("SC")=$$ERRCHK^VSITCK("SC",VSIT("SC"))
125 D:$L(VSIT("SC"),"^")>1 WRN^VSITPUT($P(VSIT("SC"),"^",2,99))
126 ; - AO
127 S VSIT("AO")=$$ERRCHK^VSITCK("AO",VSIT("AO"))
128 D:$L(VSIT("AO"),"^")>1 WRN^VSITPUT($P(VSIT("AO"),"^",2,99))
129 ; - IR
130 S VSIT("IR")=$$ERRCHK^VSITCK("IR",VSIT("IR"))
131 D:$L(VSIT("IR"),"^")>1 WRN^VSITPUT($P(VSIT("IR"),"^",2,99))
132 ; - EC
133 S VSIT("EC")=$$ERRCHK^VSITCK("EC",VSIT("EC"))
134 D:$L(VSIT("EC"),"^")>1 WRN^VSITPUT($P(VSIT("EC"),"^",2,99))
135 ; - HNC - PX*1*111 - Head & Neck
136 S VSIT("HNC")=$$ERRCHK^VSITCK("HNC",VSIT("HNC"))
137 D:$L(VSIT("HNC"),"^")>1 WRN^VSITPUT($P(VSIT("HNC"),"^",2,99))
138 ; - CV - PX*1*130 - Combat Vet
139 S VSIT("CV")=$$ERRCHK^VSITCK("CV",VSIT("CV"))
140 D:$L(VSIT("CV"),"^")>1 WRN^VSITPUT($P(VSIT("CV"),"^",2,99))
141 ; - COM
142 S VSIT("COM")=$$ERRCHK^VSITCK("COM",VSIT("COM"))
143 D:$L(VSIT("COM"),"^")>1 WRN^VSITPUT($P(VSIT("COM"),"^",2,99))
144 ; - VER
145 S VSIT("VER")=$$ERRCHK^VSITCK("VER",VSIT("VER"))
146 D:$L(VSIT("VER"),"^")>1 WRN^VSITPUT($P(VSIT("VER"),"^",2,99))
147 ; - PKG
148 S VSIT("PKG")=$$PKG2IEN^VSIT(VSIT("PKG"))
149 S VSIT("PKG")=$$ERRCHK^VSITCK("PKG",VSIT("PKG"))
150 D:$L(VSIT("PKG"),"^")>1 WRN^VSITPUT($P(VSIT("PKG"),"^",2,99))
151 ; - SOR
152 ;Lookup source in PCE DATA SOURCE file (#839.7) with LAYGO
153 I VSIT("SOR")'=+VSIT("SOR") D
154 . I $T(SOURCE^PXAPI)="" D
155 .. S VSIT("SOR")=$$SOURCE^PXAPI(VSIT("SOR"))
156 . E S VSIT("SOR")=""
157 S VSIT("SOR")=$$ERRCHK^VSITCK("SOR",VSIT("SOR"))
158 D:$L(VSIT("SOR"),"^")>1 WRN^VSITPUT($P(VSIT("SOR"),"^",2,99))
159 ;
160 ;PFSS Patient Reference
161 S VSIT("ACT")=$$ERRCHK^VSITCK("ACT",VSIT("ACT"))
162 I $$SWSTAT^IBBAPI() D:$L(VSIT("ACT"),"^")>1 WRN^VSITPUT($P(VSIT("ACT"),"^",2,99))
163 Q
164 ;
Note: See TracBrowser for help on using the repository browser.