source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DG53P629.m@ 1801

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

initial load of WorldVistAEHR

File size: 2.8 KB
RevLine 
[613]1DG53P629 ;BAY/JAT - Patient File reporting; 6/7/04 7:13pm ; 12/11/04 10:37pm
2 ;;5.3;Registration;**629**;Aug 13,1993
3 ;
4REPORT ;
5 N X1,X2
6 K ^XTMP("DG53P629",$J)
7 S X1=DT,X2=90 D C^%DTC
8 S ^XTMP("DG53P629",$J,0)=X_"^"_DT_"^Possible missing patients"
9 I $$DEVICE() D ENTER
10 Q
11 ;
12ENTER ;
13 ;
14 D READFILE
15 D ^%ZISC
16 I $D(ZTQUEUED) S ZTREQ="@"
17 Q
18DEVICE() ;
19 ;Description: allows the user to select a device.
20 ;
21 ;Output:
22 ; Function Value - Returns 0 if the user decides not to print or to
23 ; queue the report, 1 otherwise.
24 ;
25 N OK,IOP,POP,%ZIS
26 S OK=1
27 S %ZIS="MQ"
28 D ^%ZIS
29 S:POP OK=0
30 D:OK&$D(IO("Q"))
31 .N ZTRTN,ZTDESC,ZTSKM,ZTREQ,ZTSTOP
32 .S ZTRTN="ENTER^DG53P629",ZTDESC="Report of possible missing patients"
33 .D ^%ZTLOAD
34 .W !,$S($D(ZTSK):"REQUEST QUEUED TASK="_ZTSK,1:"REQUEST CANCELLED")
35 .D HOME^%ZIS
36 .S OK=0
37 Q OK
38 ;
39READFILE ;
40 N DFN,COUNT,DGDATE,DGSRCE,DGCITY,DGSTAT
41 S (DFN,COUNT)=0
42 F S DFN=$O(^DPT(DFN)) Q:'DFN D
43 .; merged record
44 .I $D(^DPT(DFN,-9)) Q
45 .; in process of being merged
46 .I $P($G(^DPT(DFN,0)),U)["MERGING INTO" Q
47 .I $P($G(^DPT(DFN,.15)),U,3)!($P($G(^DPT(DFN,"INE")),U,7))!($P($G(^DPT(DFN,"INE")),U,8))!($P($G(^DPT(DFN,"INE")),U,7)) D
48 ..S DGDATE=$P($G(^DPT(DFN,.15)),U,3)
49 ..S DGSRCE=$P($G(^DPT(DFN,"INE")),U,7)
50 ..S DGCITY=$P($G(^DPT(DFN,"INE")),U,8)
51 ..S DGSTAT=$P($G(^DPT(DFN,"INE")),U,9)
52 ..D STORE
53 ;
54 W !,"Nbr possible missing patients: "_COUNT
55 D PRINT
56 Q
57 ;
58STORE ;
59 S COUNT=COUNT+1
60 S ^XTMP("DG53P629",$J,DFN)=DGDATE_U_DGSRCE_U_DGCITY_U_DGSTAT
61 Q
62PRINT ;
63 U IO
64 N DGDDT,DGQUIT,DGPG,DGDATA,DGTEXT
65 S DGDDT=$$FMTE^XLFDT($$NOW^XLFDT,"D")
66 S (DGQUIT,DGPG)=0
67 D HEAD
68 I '$G(COUNT) D Q
69 .W !!!,?20,"*** No records to report ***"
70 W !!,"*** COUNT OF POSSIBLE MISSING PATIENTS: ",COUNT," ***",!!
71 S DFN=0
72 F S DFN=$O(^XTMP("DG53P629",$J,DFN)) Q:'DFN D Q:DGQUIT
73 .I $Y>(IOSL-4) D HEAD
74 .S DGDATA=$G(^XTMP("DG53P629",$J,DFN))
75 .S DGDATE=$P(DGDATA,U),DGSRCE=$P(DGDATA,U,2),DGCITY=$P(DGDATA,U,3),DGSTAT=$P(DGDATA,U,4)
76 .S Y=$P(DGDATE,".") D DD^%DT S DGDATE=Y
77 .S DGSRCE=$S(DGSRCE=1:"VAMC",DGSRCE=2:"RO",DGSRCE=3:"RPC",1:"")
78 .I DGSTAT>0 S DGSTAT=$P($G(^DIC(5,DGSTAT,0)),U)
79 .W ?2,DFN,?13,DGDATE,?27,DGSRCE,?34,DGCITY,?53,DGSTAT,!
80 .I '$D(^DPT(DFN,.16)) W ! Q
81 .S DGTEXT=0
82 .F S DGTEXT=$O(^DPT(DFN,.16,DGTEXT)) Q:'DGTEXT D
83 ..W ?13,$G(^DPT(DFN,.16,DGTEXT,0)),!
84 .W !
85 ;
86 I DGQUIT W:$D(ZTQUEUED) !!,"Report stopped at user's request" Q
87 I $G(DGPG)>0,$E(IOST)="C" K DIR S DIR(0)="E" D ^DIR K DIR S:+Y=0 DGQUIT=1
88 I $D(ZTQUEUED) S ZTREQ="@"
89 Q
90 ;
91HEAD ;
92 I $D(ZTQUEUED),$$S^%ZTLOAD S (ZTSTOP,DGQUIT)=1 Q
93 I $G(DGPG)>0,$E(IOST)="C" K DIR S DIR(0)="E" D ^DIR K DIR S:+Y=0 DGQUIT=1
94 Q:DGQUIT
95 S DGPG=$G(DGPG)+1
96 W @IOF,!,DGDDT,?15,"DG*5.3*629 List of possible missing patients",?70,"Page:",$J(DGPG,5),! K X S $P(X,"-",81)="" W X,!
97 W !
98 W !,?2,"DFN",?13,"DATE",?26,"SOURCE",?34,"CITY",?53,"STATE",!!
99 S $P(X,"-",81)="" W X,!
100 Q
Note: See TracBrowser for help on using the repository browser.