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

DG53P641.m

Go to the documentation of this file. 
  1. DG53P641 ;BAY/JAT - Patient File Updat; 6/7/04 7:13pm ; 1/4/05 5:06pm
  1.  ;;5.3;Registration;**641**;Aug 13,1993
  1.  Q
  1.  ;
  1. CLEANUP ;This entry point will do the update.
  1.  ;
  1.  N DGENSKIP
  1.  S DGENSKIP=0
  1.  W !,"This is a one-time update of the Patient File."
  1.  W !,"It will set the 'ATEST' cross-reference as needed."
  1.  N X1,X2
  1.  K ^XTMP("DG53P641",$J)
  1.  S X1=DT,X2=90 D C^%DTC
  1.  S ^XTMP("DG53P641",$J,0)=X_"^"_DT_"^Patient File update"
  1.  I $$DEVICE() D ENTER
  1.  Q
  1.  ;
  1. REPORT ;This entry point was provided for testing, so that before
  1.  ;patient records are updated the site can have a list of
  1.  ;the DFN's that would be affected.
  1.  ; 
  1.  ;Use this entry point to report on what the update would do.
  1.  ;No changes will be made to the database.
  1.  ;
  1.  N DGENSKIP
  1.  S DGENSKIP=1
  1.  W !,"This is a preliminary report by DFN of the Patient file"
  1.  W !,"records which would be affected by the update."
  1.  N X1,X2
  1.  K ^XTMP("DG53P641",$J)
  1.  S X1=DT,X2=90 D C^%DTC
  1.  S ^XTMP("DG53P641",$J,0)=X_"^"_DT_"^Patient File update"
  1.  I $$DEVICE() D ENTER
  1.  Q
  1.  ;
  1. ENTER ;
  1.  ;
  1.  D UPDATE(DGENSKIP)
  1.  D:(DGENSKIP) ^%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^DG53P641",ZTDESC=$S(DGENSKIP:"Report",1:"Update")_" of Patient Records"
  1.  .S ZTSAVE("DGENSKIP")=""
  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. UPDATE(DGENSKIP) ;
  1.  ;This will update patient records --
  1.  ;
  1.  ;Input: If DGENSKIP=1, the records will not be updated,
  1.  ;just reported.
  1.  ;
  1.  N DFN,COUNT,DGSSN,DGS,DGFLG,DGXREF,DGVAL,DGFDA,DGERR
  1.  S (COUNT,DFN)=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 $D(^DPT(DFN,0)) D
  1.  ..S DGSSN=$P($G(^DPT(DFN,0)),U,9)
  1.  ..Q:'DGSSN
  1.  ..Q:$E(DGSSN,1,5)'="00000"
  1.  ..Q:$D(^DPT("ATEST",DFN))
  1.  ..D UPDR
  1.  ;
  1.  D PRINT
  1.  Q
  1.  ;
  1. UPDR ;
  1.  S COUNT=COUNT+1
  1.  S ^XTMP("DG53P641",$J,DFN)=DGSSN
  1.  I 'DGENSKIP D
  1.  .N DA,DIK
  1.  .S DA=DFN,DIK="^DPT(",DIK(1)=".09^ATP"
  1.  .D EN1^DIK
  1.  Q
  1. PRINT ;
  1.  U IO
  1.  N DGDDT,DGQUIT,DGPG
  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 BAD PATIENT RECORDS"_$S(DGENSKIP:"",1:" UPDATED")_": ",COUNT," ***",!!
  1.  S DFN=0
  1.  F  S DFN=$O(^XTMP("DG53P641",$J,DFN)) Q:'DFN  D  Q:DGQUIT
  1.  .I $Y>(IOSL-4) D HEAD
  1.  .S DGSSN=$P($G(^XTMP("DG53P641",$J,DFN)),U)
  1.  .W ?2,DFN,?15,DGSSN,!
  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*641 Patient File Update Utility",?70,"Page:",$J(DGPG,5),! K X S $P(X,"-",81)="" W X,!
  1.  W !
  1.  W !,?2,"DFN",?15,"SSN",!
  1.  S $P(X,"-",81)="" W X,!
  1.  Q