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

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

initial load of WorldVistAEHR

File size: 2.8 KB
RevLine 
[613]1PXQFE ;ISL/JVS - DEPENDENT ENTRY COUNT-ENCOUNTERS (SCE) ;5/1/97 08:29
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;**4,29**;Aug 12, 1996
3 ;
4DEC(VISIT,VISUAL,EXPAND) ;Test looking through DD to find fields pointing to the visit entries.
5 ; ENCOUNTER=ENCOUNTER ien to looked up and counted
6 ; VISUAL= Set to 1 if you want and interactive display of what is found
7 ; EXPAND= SET TO 1 TO EXPAND ENTRIES
8 ;
9 ; Look for file and field
10 ;
11 N DD,BECKY,COUNT,FIELD,FILE,GET,PIECE,PX,REF,SNDPIECE,STOP,SUB,VAUGHN
12 N VAR,DEC,DECF,ORG,STS,TYP
13 ;
14 S DD="^DD"
15 S FILE=""
16 F S FILE=$O(@DD@(409.68,0,"PT",FILE)) Q:FILE="" D
17 .S FIELD=""
18 .F S FIELD=$O(@DD@(409.68,0,"PT",FILE,FIELD)) Q:FIELD="" D
19 ..S VDD(FILE,FIELD)=""
20 D REF,QUE
21 K VDDN,VDDR
22 I $G(VISUAL) S VAR="COUNT= "_COUNT W $$RE^PXQUTL(VAR)
23 Q ""
24 ;
25REF ;Look for all of the regular cross references and other
26 ;
27 S FILE="" F S FILE=$O(VDD(FILE)) Q:FILE="" D
28 .S FIELD="" F S FIELD=$O(VDD(FILE,FIELD)) Q:FIELD="" D
29 ..D REG
30 K VDD
31 Q
32 ;
33REG ;Look for regular cross references
34 ;
35 S STOP=0
36 I '$D(@DD@(FILE,FIELD,1)) S VDDN(FILE,FIELD)="" Q
37 S SUB=0 F S SUB=$O(@DD@(FILE,FIELD,1,SUB)) Q:SUB="" D
38 .S GET=$G(@DD@(FILE,FIELD,1,SUB,0)) D
39 .I $P(GET,"^",3)']"" S VDDR(FILE,SUB)=FILE_"^"_FIELD_"^"_SUB S STOP=1
40 .E S VDDN(FILE,FIELD)=""
41 Q
42QUE ;CHECK OUT CROSS REFERENCE
43 ;
44 S FILE="",FIELD="",STOP="",COUNT=0
45 F S FILE=$O(VDDR(FILE)) Q:FILE="" D
46 .S SUB=0,STOP="" F S SUB=$O(VDDR(FILE,SUB)) Q:SUB="" Q:STOP=1 S GET=$G(VDDR(FILE,SUB)) D
47 ..S REF=$G(@DD@($P(GET,"^",1),$P(GET,"^",2),1,$P(GET,"^",3),1))
48 ..I $P(REF,"""",1)["DA(1)" Q
49 ..S PIECE=$P(REF," ",2)
50 ..S SNDPIECE=$P(PIECE,"""",1,2)_""""
51 ..S VAUGHN=$P(PIECE,"""",1,2)_""")"
52 ..I $D(@VAUGHN) D S STOP=1
53 ...S PX=SNDPIECE_",VISIT)"
54 ...I $D(@PX) D
55 ....S BECKY=0 F S BECKY=$O(@PX@(BECKY)) Q:BECKY="" S COUNT=COUNT+1 S DEC=SNDPIECE_","_VISIT_","_BECKY S DECF=$$FILE(SNDPIECE,FILE) W:$G(VISUAL) $$RE^PXQUTL(DEC_" - - - - "_DECF) D
56 .....W:$G(EXPAND) $$EXP^PXQFV(SNDPIECE,BECKY)
57 .....W:$G(PXQSOR) $$SOR^PXQFE(SNDPIECE,BECKY)
58 Q
59 ;
60LINE() ;--LINE
61 Q:'$G(PXQAUDIT) ""
62 W "- - - - -"
63 Q ""
64 ;
65SOR(ROOT,IEN) ;--SOURCE OF ENCOUNTER
66 N I,REF,REF2,PKG,SOR
67 S REF=$P(ROOT,"""",1)_IEN_")"
68 S REF2=$P(ROOT,"""",1)_IEN
69 I REF["SCE" D
70 .S ORG=$P(^SCE(IEN,0),"^",8)
71 .S STS=$P(^SCE(IEN,0),"^",12) I STS>0 S STS=$P(^SD(409.63,STS,0),"^",1)
72 .S TYP=$P(^SCE(IEN,0),"^",10) I TYP>0 S TYP=$P(^SD(409.1,TYP,0),"^",1)
73 .W $$RE^PXQUTL("ORGINATING PROCESS = "_$S(ORG=1:"APPOINTMENT",ORG=2:"STOP CODE ADDITION",ORG=3:"DISPOSITION",ORG=4:"CREDIT STOP CODE",1:"**NOT STORED**"))
74 .W $$RE^PXQUTL(" CHECK-OUT STATUS = "_STS)
75 .W $$RE^PXQUTL(" APPOINTMENT TYPE = "_TYP)
76 .W $$RE^PXQUTL(" ")
77 Q ""
78FILE(RT,FILENUM) ;
79 N FILE S FILE=""
80 I '$D(FILENUM) Q "UNKNOWN"
81FF I $D(^DIC(FILENUM)) D
82 .S FILE=$P($G(^DIC(FILENUM,0)),"^",1)
83 E I $D(^DD(FILENUM)) S FILENUM=+$G(^DD(FILENUM,0,"UP")) G FF
84 Q FILE_" FILE"
Note: See TracBrowser for help on using the repository browser.