Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DG53P629

DG53P629.m

Go to the documentation of this file.
  1. DG53P629 ;BAY/JAT - Patient File reporting; 6/7/04 7:13pm ; 12/11/04 10:37pm
  1. ;;5.3;Registration;**629**;Aug 13,1993
  1. ;
  1. REPORT ;
  1. N X1,X2
  1. K ^XTMP("DG53P629",$J)
  1. S X1=DT,X2=90 D C^%DTC
  1. S ^XTMP("DG53P629",$J,0)=X_"^"_DT_"^Possible missing patients"
  1. I $$DEVICE() D ENTER
  1. Q
  1. ;
  1. ENTER ;
  1. ;
  1. D READFILE
  1. D ^%ZISC
  1. I $D(ZTQUEUED) S ZTREQ="@"
  1. Q
  1. DEVICE() ;
  1. ;Description: allows the user to select a device.
  1. ;
  1. ;Output:
  1. ; Function Value - Returns 0 if the user decides not to print or to
  1. ; queue the report, 1 otherwise.
  1. ;
  1. N OK,IOP,POP,%ZIS
  1. S OK=1
  1. S %ZIS="MQ"
  1. D ^%ZIS
  1. S:POP OK=0
  1. D:OK&$D(IO("Q"))
  1. .N ZTRTN,ZTDESC,ZTSKM,ZTREQ,ZTSTOP
  1. .S ZTRTN="ENTER^DG53P629",ZTDESC="Report of possible missing patients"
  1. .D ^%ZTLOAD
  1. .W !,$S($D(ZTSK):"REQUEST QUEUED TASK="_ZTSK,1:"REQUEST CANCELLED")
  1. .D HOME^%ZIS
  1. .S OK=0
  1. Q OK
  1. ;
  1. READFILE ;
  1. N DFN,COUNT,DGDATE,DGSRCE,DGCITY,DGSTAT
  1. S (DFN,COUNT)=0
  1. F S DFN=$O(^DPT(DFN)) Q:'DFN D
  1. .; merged record
  1. .I $D(^DPT(DFN,-9)) Q
  1. .; in process of being merged
  1. .I $P($G(^DPT(DFN,0)),U)["MERGING INTO" Q
  1. .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
  1. ..S DGDATE=$P($G(^DPT(DFN,.15)),U,3)
  1. ..S DGSRCE=$P($G(^DPT(DFN,"INE")),U,7)
  1. ..S DGCITY=$P($G(^DPT(DFN,"INE")),U,8)
  1. ..S DGSTAT=$P($G(^DPT(DFN,"INE")),U,9)
  1. ..D STORE
  1. ;
  1. W !,"Nbr possible missing patients: "_COUNT
  1. D PRINT
  1. Q
  1. ;
  1. STORE ;
  1. S COUNT=COUNT+1
  1. S ^XTMP("DG53P629",$J,DFN)=DGDATE_U_DGSRCE_U_DGCITY_U_DGSTAT
  1. Q
  1. PRINT ;
  1. U IO
  1. N DGDDT,DGQUIT,DGPG,DGDATA,DGTEXT
  1. S DGDDT=$$FMTE^XLFDT($$NOW^XLFDT,"D")
  1. S (DGQUIT,DGPG)=0
  1. D HEAD
  1. I '$G(COUNT) D Q
  1. .W !!!,?20,"*** No records to report ***"
  1. W !!,"*** COUNT OF POSSIBLE MISSING PATIENTS: ",COUNT," ***",!!
  1. S DFN=0
  1. F S DFN=$O(^XTMP("DG53P629",$J,DFN)) Q:'DFN D Q:DGQUIT
  1. .I $Y>(IOSL-4) D HEAD
  1. .S DGDATA=$G(^XTMP("DG53P629",$J,DFN))
  1. .S DGDATE=$P(DGDATA,U),DGSRCE=$P(DGDATA,U,2),DGCITY=$P(DGDATA,U,3),DGSTAT=$P(DGDATA,U,4)
  1. .S Y=$P(DGDATE,".") D DD^%DT S DGDATE=Y
  1. .S DGSRCE=$S(DGSRCE=1:"VAMC",DGSRCE=2:"RO",DGSRCE=3:"RPC",1:"")
  1. .I DGSTAT>0 S DGSTAT=$P($G(^DIC(5,DGSTAT,0)),U)
  1. .W ?2,DFN,?13,DGDATE,?27,DGSRCE,?34,DGCITY,?53,DGSTAT,!
  1. .I '$D(^DPT(DFN,.16)) W ! Q
  1. .S DGTEXT=0
  1. .F S DGTEXT=$O(^DPT(DFN,.16,DGTEXT)) Q:'DGTEXT D
  1. ..W ?13,$G(^DPT(DFN,.16,DGTEXT,0)),!
  1. .W !
  1. ;
  1. I DGQUIT W:$D(ZTQUEUED) !!,"Report stopped at user's request" Q
  1. I $G(DGPG)>0,$E(IOST)="C" K DIR S DIR(0)="E" D ^DIR K DIR S:+Y=0 DGQUIT=1
  1. I $D(ZTQUEUED) S ZTREQ="@"
  1. Q
  1. ;
  1. I $D(ZTQUEUED),$$S^%ZTLOAD S (ZTSTOP,DGQUIT)=1 Q
  1. I $G(DGPG)>0,$E(IOST)="C" K DIR S DIR(0)="E" D ^DIR K DIR S:+Y=0 DGQUIT=1
  1. Q:DGQUIT
  1. S DGPG=$G(DGPG)+1
  1. 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,!
  1. W !
  1. W !,?2,"DFN",?13,"DATE",?26,"SOURCE",?34,"CITY",?53,"STATE",!!
  1. S $P(X,"-",81)="" W X,!
  1. Q