source: FOIAVistA/tag/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DG53P600.m@ 1796

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

initial load of FOIAVistA 6/30/08 version

File size: 3.7 KB
Line 
1DG53P600 ;BAY/JAT - Patient File Updat; 6/7/04 7:13pm ; 7/16/04 3:22pm
2 ;;5.3;Registration;**600**;Aug 13,1993
3 Q
4 ;
5CLEANUP ;This entry point will do the update.
6 ;
7 N DGENSKIP
8 S DGENSKIP=0
9 W !,"This is a one-time update of the Patient File."
10 W !,"It will correct the TEST PATIENT INDICATOR flag."
11 N X1,X2
12 K ^XTMP("DG53P600",$J)
13 S X1=DT,X2=90 D C^%DTC
14 S ^XTMP("DG53P600",$J,0)=X_"^"_DT_"^Patient File update"
15 I $$DEVICE() D ENTER
16 Q
17 ;
18REPORT ;This entry point was provided for testing, so that before
19 ;patient records are updated the site can have a list of
20 ;the DFN's that would be affected.
21 ;
22 ;Use this entry point to report on what the update would do.
23 ;No changes will be made to the database.
24 ;
25 N DGENSKIP
26 S DGENSKIP=1
27 W !,"This is a preliminary report by DFN of the Patient file"
28 W !,"records which would be affected by the update."
29 N X1,X2
30 K ^XTMP("DG53P600",$J)
31 S X1=DT,X2=90 D C^%DTC
32 S ^XTMP("DG53P600",$J,0)=X_"^"_DT_"^Patient File update"
33 I $$DEVICE() D ENTER
34 Q
35 ;
36ENTER ;
37 ;
38 D UPDATE(DGENSKIP)
39 D:(DGENSKIP) ^%ZISC
40 I $D(ZTQUEUED) S ZTREQ="@"
41 Q
42DEVICE() ;
43 ;Description: allows the user to select a device.
44 ;
45 ;Output:
46 ; Function Value - Returns 0 if the user decides not to print or to
47 ; queue the report, 1 otherwise.
48 ;
49 N OK,IOP,POP,%ZIS
50 S OK=1
51 S %ZIS="MQ"
52 D ^%ZIS
53 S:POP OK=0
54 D:OK&$D(IO("Q"))
55 .N ZTRTN,ZTDESC,ZTSKM,ZTREQ,ZTSTOP
56 .S ZTRTN="ENTER^DG53P600",ZTDESC=$S(DGENSKIP:"Report",1:"Update")_" of Patient Records"
57 .S ZTSAVE("DGENSKIP")=""
58 .D ^%ZTLOAD
59 .W !,$S($D(ZTSK):"REQUEST QUEUED TASK="_ZTSK,1:"REQUEST CANCELLED")
60 .D HOME^%ZIS
61 .S OK=0
62 Q OK
63 ;
64UPDATE(DGENSKIP) ;
65 ;This will update patient records --
66 ;
67 ;Input: If DGENSKIP=1, the records will not be updated,
68 ;just reported.
69 ;
70 N DFN,COUNT,DGSSN,DGS,DGFLG,DGXREF,DGVAL,DGFDA,DGERR
71 S (COUNT,DFN)=0
72 F S DFN=$O(^DPT(DFN)) Q:'DFN D
73 .; merged record
74 .I $D(^DPT(DFN,-9)) Q
75 .; in process of being merged
76 .I $P($G(^DPT(DFN,0)),U)["MERGING INTO" Q
77 .I $D(^DPT(DFN,0)) D
78 ..S DGSSN=$P($G(^DPT(DFN,0)),U,9)
79 ..Q:'DGSSN
80 ..S DGS=$E(DGSSN,1,5)
81 ..S DGS=$S(DGS="00000":0,1:1)
82 ..S DGFLG=+$P($G(^DPT(DFN,0)),U,21)
83 ..S DGXREF=$S('$D(^DPT("ATEST",DFN)):0,1:1)
84 ..;quit if usual non-test patient
85 ..I DGS,'DGFLG,'DGXREF Q
86 ..;update
87 ..I DGS,DGFLG S DGVAL=0 D UPDR Q
88 ..I DGS,DGXREF S DGVAL=0 D UPDR Q
89 ..I 'DGS,'DGFLG S DGVAL=1 D UPDR Q
90 ..I 'DGS,'DGXREF S DGVAL=1 D UPDR Q
91 ;
92 D PRINT
93 Q
94 ;
95UPDR ;
96 S COUNT=COUNT+1
97 S DGFLG=$S(DGFLG:"YES",1:"NO")
98 S DGXREF=$S(DGXREF:"YES",1:"NO")
99 S ^XTMP("DG53P600",$J,DFN)=DGSSN_"^"_DGFLG_"^"_DGXREF
100 I 'DGENSKIP D
101 .S DGFDA(2,DFN_",",.6)=DGVAL
102 .D FILE^DIE("S","DGFDA","DGERR")
103 .I DGVAL=0 K ^DPT("ATEST",DFN)
104 Q
105PRINT ;
106 U IO
107 N DGDDT,DGQUIT,DGPG
108 S DGDDT=$$FMTE^XLFDT($$NOW^XLFDT,"D")
109 S (DGQUIT,DGPG)=0
110 D HEAD
111 I '$G(COUNT) D Q
112 .W !!!,?20,"*** No records to report ***"
113 W !!,"*** COUNT OF BAD PATIENT RECORDS"_$S(DGENSKIP:"",1:" UPDATED")_": ",COUNT," ***",!!
114 S DFN=0
115 F S DFN=$O(^XTMP("DG53P600",$J,DFN)) Q:'DFN D Q:DGQUIT
116 .I $Y>(IOSL-4) D HEAD
117 .S DGSSN=$P($G(^XTMP("DG53P600",$J,DFN)),U)
118 .S DGFLG=$P($G(^XTMP("DG53P600",$J,DFN)),U,2)
119 .S DGXREF=$P($G(^XTMP("DG53P600",$J,DFN)),U,3)
120 .W ?2,DFN,?15,DGSSN,?37,DGFLG,?56,DGXREF,!
121 ;
122 I DGQUIT W:$D(ZTQUEUED) !!,"Report stopped at user's request" Q
123 I $G(DGPG)>0,$E(IOST)="C" K DIR S DIR(0)="E" D ^DIR K DIR S:+Y=0 DGQUIT=1
124 I $D(ZTQUEUED) S ZTREQ="@"
125 Q
126 ;
127HEAD ;
128 I $D(ZTQUEUED),$$S^%ZTLOAD S (ZTSTOP,DGQUIT)=1 Q
129 I $G(DGPG)>0,$E(IOST)="C" K DIR S DIR(0)="E" D ^DIR K DIR S:+Y=0 DGQUIT=1
130 Q:DGQUIT
131 S DGPG=$G(DGPG)+1
132 W @IOF,!,DGDDT,?15,"DG*5.3*600 Patient File Update Utility",?70,"Page:",$J(DGPG,5),! K X S $P(X,"-",81)="" W X,!
133 W !
134 W !,?2,"DFN",?15,"SSN",?26,"Test Patient Indicator",?50,"'ATEST' crossref",!
135 S $P(X,"-",81)="" W X,!
136 Q
Note: See TracBrowser for help on using the repository browser.