source: WorldVistAEHR/trunk/r/PCE_PATIENT_CARE_ENCOUNTER-AUTN-EFDP-PX-VSIT--PXRM/PXUTL1.m@ 1361

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

initial load of WorldVistAEHR

File size: 3.6 KB
RevLine 
[613]1PXUTL1 ;ISL/dee - Utility routines used by PCE ;4/3/97
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;**25,134,149**;Aug 12, 1996
3 ;; ;
4 Q
5 ;
6EXTTEXT(IEN,REQUIRED,FILE,FIELD1,FIELD2) ;Returns the external form.
7 ;Parameters:
8 ; IEN the ien in the file that the text is wanted for.
9 ; REQUIRED if this is not zero and no text is found
10 ; then "UNKNOWN" is returned.
11 ; FILE the file number
12 ; FIELD1 the field number that the text is in
13 ; FIELD2 if the parameter is passed and there is no text
14 ; in field1 then the text in this field will be
15 ; returned if there is some.
16 ;
17 N DIC,DR,DA,DIQ,PXUTDIQ1,PXTEXT,Y,X
18 I $G(FILE)>0,$G(FIELD1)>0 D
19 . S DIC=FILE
20 . S DR=FIELD1
21 . S:$G(FIELD2)>0 DR=DR_";"_FIELD2
22 . S DA=IEN
23 . S DIQ="PXUTDIQ1("
24 . S DIQ(0)="E"
25 . D EN^DIQ1
26 . I $G(PXUTDIQ1(FILE,DA,FIELD1,"E"))]"" S PXTEXT=PXUTDIQ1(FILE,DA,FIELD1,"E")
27 . E I $G(FIELD2)>0,$G(PXUTDIQ1(FILE,DA,FIELD2,"E"))]"" S PXTEXT=PXUTDIQ1(FILE,DA,FIELD2,"E")
28 . E I REQUIRED S PXTEXT="UNKNOWN"
29 E I REQUIRED S PXTEXT="UNKNOWN"
30 Q PXTEXT
31 ;
32PRIMVPRV(PXUTVST) ;Returns the primary provider if there is one
33 ; for the passed visit otherwise returns 0.
34 N PXCATEMP
35 S PXCATEMP=$$PRIMSEC(PXUTVST,"^AUPNVPRV",0,4)
36 Q $S(PXCATEMP>0:$P(^AUPNVPRV(PXCATEMP,0),"^"),1:0)
37 ;
38PRIMVPOV(PXUTVST) ;Returns the primary diagnosis if there is one
39 ; for the passed visit otherwise returns 0.
40 N PXCATEMP
41 S PXCATEMP=$$PRIMSEC(PXUTVST,"^AUPNVPOV",0,12)
42 Q $S(PXCATEMP>0:$P(^AUPNVPOV(PXCATEMP,0),"^"),1:0)
43 ;
44PRIMSEC(PXUTVST,PXUTAUPN,PXUTNODE,PXUPIECE) ;Returns ien of the primary one
45 ; if there is one for the passed visit otherwise returns 0.
46 ; Parameters:
47 ; PXUTVST Pointer to the visit
48 ; PXUTAUPN V-File global e.g. "^AUPNVPRV"
49 ; PXUTNODE The node that the Primary/Secondary field is on
50 ; PXUPIECE The piece of the Primary/Secondary field
51 ;
52 N PXUTPRIM
53 S PXUTPRIM=0
54 F S PXUTPRIM=$O(@(PXUTAUPN_"(""AD"",PXUTVST,PXUTPRIM)")) Q:PXUTPRIM'>0 I "P"=$P(@(PXUTAUPN_"(PXUTPRIM,PXUTNODE)"),"^",PXUPIECE) Q
55 Q +PXUTPRIM
56 ;
57DISPOSIT(PXUTLDFN,PXUTLDT,PXUTVIEN) ;Checks to see if a visit is a dispoition
58 I PXUTVIEN=+$P($G(^SCE(+$P($G(^DPT(+PXUTLDFN,"DIS",9999999-PXUTLDT,0)),"^",18),0)),"^",5) Q +$P($G(^DPT(+PXUTLDFN,"DIS",9999999-PXUTLDT,0)),"^",18)
59 Q 0
60 ;
61APPOINT(PXUTLDFN,PXUTLDT,HLOC) ;Returns 1 if the patient has and appointment
62 ;at PXUTLDT for clinic HLOC.
63 Q HLOC=+$G(^DPT(+PXUTLDFN,"S",+PXUTLDT,0))
64 ;
65VST2APPT(VISIT) ;Is this visit related to an appointment
66 ;Returns
67 ; 1 if the visit is being pointed to by an appointment
68 ; 0 if the visit is NOT being pointed to by an appointment
69 ;-1 if the visit is invalued
70 ;
71 N VISIT0
72 S VISIT0=$G(^AUPNVSIT($G(VISIT),0))
73 Q:VISIT0="" -1
74 Q $$VSTAPPT($P(VISIT0,"^",5),$P(VISIT0,"^",1),$P(VISIT0,"^",22),VISIT)
75 ;
76VSTAPPT(PXUTLPAT,PXUTLDT,PXUTLLOC,PXUTLVST) ;Returns 1 if the visit is being pointed to by an
77 ; appointment otherwise 0.
78 I PXUTLLOC]"",PXUTLLOC=+$G(^DPT(+PXUTLPAT,"S",+PXUTLDT,0)),PXUTLVST=+$P($G(^SCE(+$P($G(^DPT(PXUTLPAT,"S",PXUTLDT,0)),"^",20),0)),"^",5) Q 1
79 Q 0
80 ;
81APPT2VST(PXUTLPAT,PXUTLDT,HLOC) ;Returns ien of visit that the related
82 ;appointment points to at PXUTLDT for clinic HLOC otherwise 0.
83 I HLOC=+$G(^DPT(+PXUTLPAT,"S",+PXUTLDT,0)) Q +$P($G(^SCE(+$P($G(^DPT(PXUTLPAT,"S",PXUTLDT,0)),"^",20),0)),"^",5)
84 Q 0
85 ;
86DXNARR(PXDXCDE,PXUTLDT) ;Returns the versioned text of file #80, field #10
87 N PXLDX,PXNO,PXCOD
88 I $G(PXDXCDE)="" Q ""
89 S PXCOD=$P($$ICDDX^ICDCODE(PXDXCDE),"^",2) S:$G(PXUTLDT)="" PXUTLDT=DT
90 S PXNO=$$ICDD^ICDCODE(PXCOD,"PXLDX",PXUTLDT)
91 Q $S(PXNO>0:PXLDX(1),1:"")
92 ;
Note: See TracBrowser for help on using the repository browser.