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

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

initial load of WorldVistAEHR
File size: 4.4 KB
RevLine 
[613]1PXQMAIN2 ;ISL/JVS - MAIN MENU ROUTINE #3 ;8/29/96 10:33
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;**4**;Aug 12, 1996
3 ;
4MENU ;--MENU FOR WHAT TO DISPLAY FOR VISIT
5 ;--OPTION 9
6 N LOC9,NAME,PAT9,POP,Y
7 S DIR("A")="Select a Display"
8 S DIR(0)="SOM^P:Patient files;L:Location files"
9 D ^DIR I Y=""!(Y["^") G CLOSE
10 I Y="P" D PAT G MENU
11 I Y="L" D LOC G MENU
12 K DIR("A"),DIR(0)
13 G CLOSE
14 ;
15PAT ;--PATIENT FILES
16 ;--GENERAL ERRORS IN THE DATA BASE
17 ;--OPEN DEVICE
18 S OPTION="9P"
19 D ZIS^PXQZIS G:POP EXIT
20 ;--RESET $X,$Y
21 N DX,DY S (DX,DY)=0 X ^%ZOSF("XY")
22PAT9P ;--BODY
23 N PAT,I,PXQRECI,SSN,SSN1,FLAG1,FLAG2,FLAG3,PAT2,LOC
24 N PAT2,LOC4,FLAG4,FLAG5
25 S PXQRECI=0
26 I '$D(^DD(2,.09,1,800)) W $$RE^PXQUTL(" ERROR ")
27 I '$D(^DD(2,.09,1,800)) W $$RE^PXQUTL("** NO CROSS-REFERENCE IN FILE#2 ON SSN FIELD FOR UPDATING FILE#9000001**")
28 I '$D(^DD(2,.09,1,800)) W $$RE^PXQUTL("** CROSS-REFERENCE COMES WITH PATIENT/IHS SUBSET PACKAGE**"),$$RE^PXQUTL(" ")
29 W $$RE^PXQUTL("Compare of #2 and # 9000001 Patient files"),$$RE^PXQUTL(" ")
30 S PAT=$$PTFLE^PXQUTL
31 S PAT2="^DPT(0) = "_$G(^DPT(0)),PAT9="^AUPNPAT(0) = "_$G(^AUPNPAT(0))
32 W $$RE^PXQUTL(" "_PAT2),$$RE^PXQUTL(" "_PAT9)
33 I $P(PAT,"^",1)=$P(PAT,"^",2) W $$RE^PXQUTL(" Zero Nodes MATCH")
34 I $P(PAT,"^",1)'=$P(PAT,"^",2) W $$RE^PXQUTL(" Zero Nodes DO NOT Match")
35 W $$RE^PXQUTL(" ")
36 ;
37 ;
38 I IOST["C-" D WAIT^DICD
39 N PXQCNT,PXQLIMIT
40 S PXQCNT=0,PXQLIMIT=100
41 S I=0 F S I=$O(^DPT(I)) Q:I'>0 Q:PXQCNT>PXQLIMIT I '$D(^AUPNPAT(I)) D
42 .S PXQCNT=PXQCNT+1
43 .I '$G(FLAG1) W $$RE^PXQUTL("Patients in file #2 but not in #9000001"),$$RE^PXQUTL(" DFN NAME SSN") S FLAG1=1
44 .S NAME=$P($G(^DPT(I,0)),"^",1),SSN=$P($G(^DPT(I,0)),"^",9)
45 .W $$RE^PXQUTL(""""_I_""",?10,"""_$E(NAME,1,20)_""",?32,"""_SSN_"""")
46 W $$RE^PXQUTL(" ")
47 I PXQCNT>PXQLIMIT W $$RE^PXQUTL("**There are more that 100 of these so I'll quit with 100**")
48 W $$RE^PXQUTL(" ")
49 ;
50 S I=0 F S I=$O(^AUPNPAT(I)) Q:I'>0 I '$D(^DPT(I)) D
51 .I '$G(FLAG2) W $$RE^PXQUTL("Patients in file #9000001 but not in #2"),$$RE^PXQUTL(" DFN NAME SSN") S FLAG2=1
52 .S NAME="**UNKNOWN**",SSN1=$P($G(^AUPNPAT(I,41,+$$SITE^VASITE,0)),"^",2)
53 .W $$RE^PXQUTL(""""_I_""",?10,"""_NAME_""",?32,"""_SSN1_"""")
54 W $$RE^PXQUTL(" ")
55 ;
56 S I=0 F S I=$O(^DPT(I)) Q:I'>0 I $D(^AUPNPAT(I)) D
57 .S NAME=$P($G(^DPT(I,0)),"^",1),SSN=$P($G(^DPT(I,0)),"^",9),SSN1=$P($G(^AUPNPAT(I,41,+$$SITE^VASITE,0)),"^",2)
58 .I SSN'=SSN1 D
59 ..I '$G(FLAG3) W $$RE^PXQUTL("SSN'S in #2 not equal to #9000001"),$$RE^PXQUTL(" DFN NAME #2 #9000001") S FLAG3=1
60 ..W $$RE^PXQUTL(""""_I_""",?10,"""_$E(NAME,1,20)_""",?32,"""_SSN_""",?45,"""_SSN1_"""")
61 W $$RE^PXQUTL(" ")
62 ;
63 ;
64 I $P(PAT,"^",1)=$P(PAT,"^",2) D
65 .I '$G(FLAG1) W $$RE^PXQUTL("PATIENT file #2 and PATIENT/IHS file #9000001 are in sync.")
66 D READ^PXQUTL
67 ;--CLOSE DEVICE
68 D ^%ZISC
69 I $D(ZTSK) G CLOSE
70 E Q
71 ;
72LOC ;--LOCATION FILES
73 ;--GENERAL ERRORS IN THE DATA BASE
74 ;--OPEN DEVICE
75 S OPTION="9L"
76 D ZIS^PXQZIS G:POP EXIT
77 ;--RESET $X,$Y
78 N DX,DY S (DX,DY)=0 X ^%ZOSF("XY")
79LOC9L ;--BODY
80 N PAT,I,PXQRECI,SSN,SSN1,FLAG1,FLAG2,FLAG3,PAT2,LOC
81 N PAT2,LOC4,FLAG4,FLAG5
82 S PXQRECI=0
83 ;--location files
84 W $$RE^PXQUTL("Compare of #4 and # 9999999.06 location files"),$$RE^PXQUTL(" ")
85 S LOC=$$LCFLE^PXQUTL
86 S LOC4="^DIC(4,0) = "_$G(^DIC(4,0)),LOC9="^AUTTLOC(0) = "_$G(^AUTTLOC(0))
87 W $$RE^PXQUTL(" "_LOC4),$$RE^PXQUTL(" "_LOC9)
88 I $P(LOC,"^",1)=$P(LOC,"^",2) W $$RE^PXQUTL(" Zero Nodes MATCH")
89 I $P(LOC,"^",1)'=$P(LOC,"^",2) W $$RE^PXQUTL(" Zero Nodes DO NOT Match")
90 W $$RE^PXQUTL(" ")
91 ;
92 ;
93 I IOST["C-" D WAIT^DICD
94 ;
95 S I=0 F S I=$O(^DIC(4,I)) Q:I'>0 I '$D(^AUTTLOC(I)) D
96 .I '$G(FLAG4) W $$RE^PXQUTL("Locations in file #4 but not in #9999999.06"),$$RE^PXQUTL(" IEN NAME") S FLAG4=1
97 .S NAME=$P($G(^DIC(4,I,0)),"^",1)
98 .W $$RE^PXQUTL(""""_I_""",?10,"""_NAME_"""")
99 W $$RE^PXQUTL(" ")
100 ;
101 S I=0 F S I=$O(^AUTTLOC(I)) Q:I'>0 I '$D(^DIC(4,I)) D
102 .I '$G(FLAG5) W $$RE^PXQUTL("Locations in file #9999999.06 but not in #4"),$$RE^PXQUTL(" IEN NAME") S FLAG5=1
103 .S NAME="**UNKNOWN**"
104 .W $$RE^PXQUTL(""""_I_""",?10,"""_NAME_"""")
105 W $$RE^PXQUTL(" ")
106 ;
107 I $P(LOC,"^",1)=$P(LOC,"^",2) D
108 .I '$G(FLAG4) W $$RE^PXQUTL("INSTITUTION file #4 and LOCATION file #9999999.06 are in sync.")
109 D READ^PXQUTL
110 ;--CLOSE DEVICE
111 D ^%ZISC
112 I $D(ZTSK) G CLOSE
113 E Q
114 ;
115CLOSE ;--CLOSE DEVICE
116 D ^%ZISC
117 K OPTION
118 ;--RETURN TO MENU
119 ;R !,"Press any key to return to the menu",ANS:DTIME
120 Q
121 ;
122EXIT ;--EXIT
123 K OPTION
124 Q
Note: See TracBrowser for help on using the repository browser.