[613] | 1 | DG53P600 ;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 | ;
|
---|
| 5 | CLEANUP ;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 | ;
|
---|
| 18 | REPORT ;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 | ;
|
---|
| 36 | ENTER ;
|
---|
| 37 | ;
|
---|
| 38 | D UPDATE(DGENSKIP)
|
---|
| 39 | D:(DGENSKIP) ^%ZISC
|
---|
| 40 | I $D(ZTQUEUED) S ZTREQ="@"
|
---|
| 41 | Q
|
---|
| 42 | DEVICE() ;
|
---|
| 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 | ;
|
---|
| 64 | UPDATE(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 | ;
|
---|
| 95 | UPDR ;
|
---|
| 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
|
---|
| 105 | PRINT ;
|
---|
| 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 | ;
|
---|
| 127 | HEAD ;
|
---|
| 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
|
---|