[613] | 1 | DG53P629 ;BAY/JAT - Patient File reporting; 6/7/04 7:13pm ; 12/11/04 10:37pm
|
---|
| 2 | ;;5.3;Registration;**629**;Aug 13,1993
|
---|
| 3 | ;
|
---|
| 4 | REPORT ;
|
---|
| 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 | ;
|
---|
| 12 | ENTER ;
|
---|
| 13 | ;
|
---|
| 14 | D READFILE
|
---|
| 15 | D ^%ZISC
|
---|
| 16 | I $D(ZTQUEUED) S ZTREQ="@"
|
---|
| 17 | Q
|
---|
| 18 | DEVICE() ;
|
---|
| 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 | ;
|
---|
| 39 | READFILE ;
|
---|
| 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 | ;
|
---|
| 58 | STORE ;
|
---|
| 59 | S COUNT=COUNT+1
|
---|
| 60 | S ^XTMP("DG53P629",$J,DFN)=DGDATE_U_DGSRCE_U_DGCITY_U_DGSTAT
|
---|
| 61 | Q
|
---|
| 62 | PRINT ;
|
---|
| 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 | ;
|
---|
| 91 | HEAD ;
|
---|
| 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
|
---|