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

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

initial load of WorldVistAEHR
File size: 4.7 KB
RevLine 
[613]1PXQFV ;ISL/ARS,JVS - DEPENDENT ENTRY COUNT-VISITS(AUPNVSIT) ;5/1/97 08:30
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 ; VISIT=Visit 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 DEC,DECF,ENTRY,VAR
13 ;
14 S DD="^DD"
15 S FILE=""
16 F S FILE=$O(@DD@(9000010,0,"PT",FILE)) Q:FILE="" D
17 .S FIELD=""
18 .F S FIELD=$O(@DD@(9000010,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 N PFILE
45 W:($G(EXPAND)&('$G(BROKEN))) $$EXP("^AUPNVSIT(",VISIT)
46 S FILE="",FIELD="",STOP="",COUNT=0
47 F S FILE=$O(VDDR(FILE)) Q:FILE="" D
48 .S SUB=0,STOP="" F S SUB=$O(VDDR(FILE,SUB)) Q:SUB="" Q:STOP=1 S GET=$G(VDDR(FILE,SUB)) D
49 ..S REF=$G(@DD@($P(GET,"^",1),$P(GET,"^",2),1,$P(GET,"^",3),1))
50 ..I $P(REF,"""",1)["DA(1)" Q
51 ..S PIECE=$P(REF," ",2)
52 ..S SNDPIECE=$P(PIECE,"""",1,2)_""""
53 ..S VAUGHN=$P(PIECE,"""",1,2)_""")"
54 ..I $D(@VAUGHN) D S STOP=1
55 ...S PX=SNDPIECE_",VISIT)"
56 ...I $D(@PX) D
57 ....I '$G(EXPAND) 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
58 .....I $G(BROKEN),SNDPIECE["AUPNVCPT" S (DFN,PATIENT)=$P($G(^AUPNVCPT(BECKY,0)),"^",2)
59 .....I $G(BROKEN),SNDPIECE["SCE" S DATE=$P($G(^SCE(BECKY,0)),"^",1)
60 .....W:$G(EXPAND) $$EXP^PXQUTL(SNDPIECE,BECKY)
61 .....W:$G(PXQSOR) $$SOR(SNDPIECE,BECKY),$$SOR^PXQFE(SNDPIECE,BECKY)
62 .....W:$G(PXQAUDIT) $$AUDIT(SNDPIECE,BECKY)
63 ....I $G(EXPAND) S BECKY=0 F S BECKY=$O(@PX@(BECKY)) Q:BECKY="" S COUNT=COUNT+1 S PFILE=$$FILE(SNDPIECE,FILE) W:$G(VISUAL) $$RE^PXQUTL(" "_PFILE_" ") D
64 .....W:$G(EXPAND) $$EXP^PXQUTL(SNDPIECE,BECKY)
65 .....W:$G(PXQSOR) $$SOR(SNDPIECE,BECKY),$$SOR^PXQFE(SNDPIECE,BECKY)
66 .....W:$G(PXQAUDIT) $$AUDIT(SNDPIECE,BECKY)
67 Q
68LINE() ;
69 Q:'$G(PXQAUDIT) ""
70 W "- - - - -"
71 Q ""
72AUDIT(ROOT,IEN) ;---AUDIT TRAIL OF ENTRIES
73 N I,REF,REF2,SOURCE,ACTION,PERSON,NOD,J
74 S REF=$P(ROOT,"""",1)_IEN_")"
75 S REF2=$P(ROOT,"""",1)_IEN
76 F S REF=$Q(@REF) Q:REF'[REF2 D
77 .I REF[",801" S NOD=$P(@REF,"^",2) Q:NOD']"" D
78 ..;W "ACTION",?26,"SOURCE",?52,"PERSON"
79 ..W $$RE^PXQUTL("ACTION SOURCE PERSON")
80 ..F I=1:1:$L(NOD,";") S J=$P(NOD,";",I) Q:J']"" D
81 ...S SOURCE=$P(^PX(839.7,$P(J,"-",1),0),"^",1)
82 ...S ACTION=$P($P(J,"-",2)," ",1) S ACTION=$S(ACTION="E":"EDIT",ACTION="A":"CREATED",1:"")
83 ...S PERSON=$P(^VA(200,$P(J," ",2),0),"^",1)
84 ...W $$RE^PXQUTL(""""_ACTION_""",?16,"""_SOURCE_""",?45,"""_PERSON_"""")
85 W $$RE^PXQUTL("___________________________________________________________")
86 Q ""
87 ;----FUNCTIONS
88SOR(ROOT,IEN) ;---EXPAND ENTRIES
89 N I,REF,REF2,PKG,SOR,ADD,EDT
90 ;I ROOT["SCE",$P($G(^SCE(IEN,0)),"^",6)="",$G(PXQPRM)=1 D
91 ;.W $$RE^PXQUTL(" ~~~~ERROR~~~")
92 ;.W $$RE^PXQUTL("** There is more Than 1 PARENT OUTPATIENT ENCOUNTER pointing to the same VISIT**")
93 ;.W $$RE^PXQUTL(" ")
94 ;I ROOT["SCE",$P($G(^SCE(IEN,0)),"^",6)="" S PXQPRM=1
95 S (PKG,SOR)=""
96 S REF=$P(ROOT,"""",1)_IEN_")"
97 S REF2=$P(ROOT,"""",1)_IEN
98 F S REF=$Q(@REF) Q:REF'[REF2 D
99 .I REF[",812" S PKG=$P(@REF,"^",2),SOR=$P(@REF,"^",3) D
100 ..I PKG>0,$D(^DIC(9.4,$G(PKG))) S PKG=$P(^DIC(9.4,$G(PKG),0),"^",1)
101 ..I SOR>0 S SOR=$P(^PX(839.7,$G(SOR),0),"^",1)
102 ..S PKG="PACKAGE ="_$G(PKG)
103 ..W $$RE^PXQUTL(PKG)
104 ..S SOR="SOURCE ="_$G(SOR)
105 ..W $$RE^PXQUTL(SOR)
106 S (PKG,SOR)=""
107 K ADD,EDT
108 Q ""
109EXP(ROOT,IEN) ;---EXPAND ENTRIES
110 N I,REF,REF2
111 S REF=$P(ROOT,"""",1)_IEN_")"
112 S REF2=$P(ROOT,"""",1)_IEN
113 F S REF=$Q(@REF) Q:REF'[REF2 S ENTRY=REF_" = "_@REF W $$RE^PXQUTL(ENTRY)
114 I '$G(PXQSOR) W $$RE^PXQUTL("___")
115 I REF["AUPNVSIT" W $$RE^PXQUTL(" ")
116 Q ""
117FILE(RT,FILENUM) ;
118 N FILE S FILE=""
119 I '$D(FILENUM) Q "UNKNOWN"
120FF I $D(^DIC(FILENUM)) D
121 .S FILE=$P($G(^DIC(FILENUM,0)),"^",1)
122 E I $D(^DD(FILENUM)) S FILENUM=+$G(^DD(FILENUM,0,"UP")) G FF
123 Q FILE_" FILE"
124PL ;--CHECK PAGE LENGTH
125 N ANS,DX,DY
126 I IOST["C-",$Y>22 S DX=0,DY=0 X ^%ZOSF("XY") R !,"Press ENTER to continue: ",ANS:DTIME
127 Q
Note: See TracBrowser for help on using the repository browser.