Routine: DG53P600

DG53P600 ;BAY/JAT - Patient File Updat; 6/7/04 7:13pm ; 7/16/04 3:22pm

 ;;5.3;Registration;**600,1015**;Aug 13,1993;Build 21

CLEANUP ;This entry point will do the update.

 N DGENSKIP

 S DGENSKIP=0

 W !,"This is a one-time update of the Patient File."

 W !,"It will correct the TEST PATIENT INDICATOR flag."

 N X1,X2

 K ^XTMP("DG53P600",$J)

 S X1=DT,X2=90 D C^%DTC

 S ^XTMP("DG53P600",$J,0)=X_"^"_DT_"^Patient File update"

 I $$DEVICE() D ENTER

REPORT ;This entry point was provided for testing, so that before

 ;patient records are updated the site can have a list of

 ;the DFN's that would be affected.

 ;Use this entry point to report on what the update would do.

 ;No changes will be made to the database.

 N DGENSKIP

 S DGENSKIP=1

 W !,"This is a preliminary report by DFN of the Patient file"

 W !,"records which would be affected by the update."

 N X1,X2

 K ^XTMP("DG53P600",$J)

 S X1=DT,X2=90 D C^%DTC

 S ^XTMP("DG53P600",$J,0)=X_"^"_DT_"^Patient File update"

 I $$DEVICE() D ENTER

ENTER ;

 D UPDATE(DGENSKIP)

 D:(DGENSKIP) ^%ZISC

 I $D(ZTQUEUED) S ZTREQ="@"

DEVICE() ;

 ;Description: allows the user to select a device.

 ;Output:

 ;  Function Value - Returns 0 if the user decides not to print or to

 ;       queue the report, 1 otherwise.

 N OK,IOP,POP,%ZIS

 S OK=1

 S %ZIS="MQ"

 D ^%ZIS

 S:POP OK=0

 D:OK&$D(IO("Q"))

 .N ZTRTN,ZTDESC,ZTSKM,ZTREQ,ZTSTOP

 .S ZTRTN="ENTER^DG53P600",ZTDESC=$S(DGENSKIP:"Report",1:"Update")_" of Patient Records"

 .S ZTSAVE("DGENSKIP")=""

 .D ^%ZTLOAD

 .W !,$S($D(ZTSK):"REQUEST QUEUED TASK="_ZTSK,1:"REQUEST CANCELLED")

 .D HOME^%ZIS

 .S OK=0

 Q OK

UPDATE(DGENSKIP) ;

 ;This will update patient records --

 ;Input: If DGENSKIP=1, the records will not be updated,

 ;just reported.

 N DFN,COUNT,DGSSN,DGS,DGFLG,DGXREF,DGVAL,DGFDA,DGERR

 S (COUNT,DFN)=0

 F  S DFN=$O(^DPT(DFN)) Q:'DFN  D

 .; merged record

 .I $D(^DPT(DFN,-9)) Q

 .; in process of being merged

 .I $P($G(^DPT(DFN,0)),U)["MERGING INTO" Q

 .I $D(^DPT(DFN,0)) D

 ..S DGSSN=$P($G(^DPT(DFN,0)),U,9)

 ..Q:'DGSSN

 ..S DGS=$E(DGSSN,1,5)

 ..S DGS=$S(DGS="00000":0,1:1)

 ..S DGFLG=+$P($G(^DPT(DFN,0)),U,21)

 ..S DGXREF=$S('$D(^DPT("ATEST",DFN)):0,1:1)

 ..;quit if usual non-test patient

 ..I DGS,'DGFLG,'DGXREF Q

 ..;update

 ..I DGS,DGFLG S DGVAL=0 D UPDR Q

 ..I DGS,DGXREF S DGVAL=0 D UPDR Q

 ..I 'DGS,'DGFLG S DGVAL=1 D UPDR Q

 ..I 'DGS,'DGXREF S DGVAL=1 D UPDR Q

 D PRINT

UPDR ;

 S COUNT=COUNT+1

 S DGFLG=$S(DGFLG:"YES",1:"NO")

 S DGXREF=$S(DGXREF:"YES",1:"NO")

 S ^XTMP("DG53P600",$J,DFN)=DGSSN_"^"_DGFLG_"^"_DGXREF

 I 'DGENSKIP D

 .S DGFDA(2,DFN_",",.6)=DGVAL

 .D FILE^DIE("S","DGFDA","DGERR")

 .I DGVAL=0 K ^DPT("ATEST",DFN)

PRINT ;

 U IO

 N DGDDT,DGQUIT,DGPG

 S DGDDT=$$FMTE^XLFDT($$NOW^XLFDT,"D")

 S (DGQUIT,DGPG)=0

 D HEAD

 I '$G(COUNT) D  Q

 .W !!!,?20,"*** No records to report ***"

 W !!,"*** COUNT OF BAD PATIENT RECORDS"_$S(DGENSKIP:"",1:" UPDATED")_": ",COUNT," ***",!!

 S DFN=0

 F  S DFN=$O(^XTMP("DG53P600",$J,DFN)) Q:'DFN  D  Q:DGQUIT

 .I $Y>(IOSL-4) D HEAD

 .S DGSSN=$P($G(^XTMP("DG53P600",$J,DFN)),U)

 .S DGFLG=$P($G(^XTMP("DG53P600",$J,DFN)),U,2)

 .S DGXREF=$P($G(^XTMP("DG53P600",$J,DFN)),U,3)

 .W ?2,DFN,?15,DGSSN,?37,DGFLG,?56,DGXREF,!

 I DGQUIT W:$D(ZTQUEUED) !!,"Report stopped at user's request" Q

 I $G(DGPG)>0,$E(IOST)="C" K DIR S DIR(0)="E" D ^DIR K DIR S:+Y=0 DGQUIT=1

 I $D(ZTQUEUED) S ZTREQ="@"

HEAD ;

 I $D(ZTQUEUED),$$S^%ZTLOAD S (ZTSTOP,DGQUIT)=1 Q

 I $G(DGPG)>0,$E(IOST)="C" K DIR S DIR(0)="E" D ^DIR K DIR S:+Y=0 DGQUIT=1

 Q:DGQUIT

 S DGPG=$G(DGPG)+1

 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,!

W !

 W !,?2,"DFN",?15,"SSN",?26,"Test Patient Indicator",?50,"'ATEST' crossref",!

 S $P(X,"-",81)="" W X,!

DG53P600  ;BAY/JAT - Patient File Updat; 6/7/04 7:13pm ; 7/16/04 3:22pm

 +1       ;;5.3;Registration;**600,1015**;Aug 13,1993;Build 21

 +2        QUIT

 +3       ;

CLEANUP   ;This entry point will do the update.

 +1       ;

 +2        NEW DGENSKIP

 +3        SET DGENSKIP=0

 +4        WRITE !,"This is a one-time update of the Patient File."

 +5        WRITE !,"It will correct the TEST PATIENT INDICATOR flag."

 +6        NEW X1,X2

 +7        KILL ^XTMP("DG53P600",$JOB)

 +8        SET X1=DT

           SET X2=90

           DO C^%DTC

 +9        SET ^XTMP("DG53P600",$JOB,0)=X_"^"_DT_"^Patient File update"

 +10       IF $$DEVICE()

               DO ENTER

 +11       QUIT

 +12      ;

REPORT    ;This entry point was provided for testing, so that before

 +1       ;patient records are updated the site can have a list of

 +2       ;the DFN's that would be affected.

 +3       ;

 +4       ;Use this entry point to report on what the update would do.

 +5       ;No changes will be made to the database.

 +6       ;

 +7        NEW DGENSKIP

 +8        SET DGENSKIP=1

 +9        WRITE !,"This is a preliminary report by DFN of the Patient file"

 +10       WRITE !,"records which would be affected by the update."

 +11       NEW X1,X2

 +12       KILL ^XTMP("DG53P600",$JOB)

 +13       SET X1=DT

           SET X2=90

           DO C^%DTC

 +14       SET ^XTMP("DG53P600",$JOB,0)=X_"^"_DT_"^Patient File update"

 +15       IF $$DEVICE()

               DO ENTER

 +16       QUIT

 +17      ;

ENTER     ;

 +1       ;

 +2        DO UPDATE(DGENSKIP)

 +3        IF (DGENSKIP)

               DO ^%ZISC

 +4        IF $DATA(ZTQUEUED)

               SET ZTREQ="@"

 +5        QUIT

DEVICE()  ;

 +1       ;Description: allows the user to select a device.

 +2       ;

 +3       ;Output:

 +4       ;  Function Value - Returns 0 if the user decides not to print or to

 +5       ;       queue the report, 1 otherwise.

 +6       ;

 +7        NEW OK,IOP,POP,%ZIS

 +8        SET OK=1

 +9        SET %ZIS="MQ"

 +10       DO ^%ZIS

 +11       IF POP

               SET OK=0

 +12       IF OK&$DATA(IO("Q"))

               Begin DoDot:1

 +13               NEW ZTRTN,ZTDESC,ZTSKM,ZTREQ,ZTSTOP

 +14               SET ZTRTN="ENTER^DG53P600"

                   SET ZTDESC=$SELECT(DGENSKIP:"Report",1:"Update")_" of Patient Records"

 +15               SET ZTSAVE("DGENSKIP")=""

 +16               DO ^%ZTLOAD

 +17               WRITE !,$SELECT($DATA(ZTSK):"REQUEST QUEUED TASK="_ZTSK,1:"REQUEST CANCELLED")

 +18               DO HOME^%ZIS

 +19               SET OK=0

               End DoDot:1

 +20       QUIT OK

 +21      ;

UPDATE(DGENSKIP) ;

 +1       ;This will update patient records --

 +2       ;

 +3       ;Input: If DGENSKIP=1, the records will not be updated,

 +4       ;just reported.

 +5       ;

 +6        NEW DFN,COUNT,DGSSN,DGS,DGFLG,DGXREF,DGVAL,DGFDA,DGERR

 +7        SET (COUNT,DFN)=0

 +8        FOR

               SET DFN=$ORDER(^DPT(DFN))

               IF 'DFN

                   QUIT

               Begin DoDot:1

 +9       ; merged record

 +10               IF $DATA(^DPT(DFN,-9))

                       QUIT

 +11      ; in process of being merged

 +12               IF $PIECE($GET(^DPT(DFN,0)),U)["MERGING INTO"

                       QUIT

 +13               IF $DATA(^DPT(DFN,0))

                       Begin DoDot:2

 +14                       SET DGSSN=$PIECE($GET(^DPT(DFN,0)),U,9)

 +15                       IF 'DGSSN

                               QUIT

 +16                       SET DGS=$EXTRACT(DGSSN,1,5)

 +17                       SET DGS=$SELECT(DGS="00000":0,1:1)

 +18                       SET DGFLG=+$PIECE($GET(^DPT(DFN,0)),U,21)

 +19                       SET DGXREF=$SELECT('$DATA(^DPT("ATEST",DFN)):0,1:1)

 +20      ;quit if usual non-test patient

 +21                       IF DGS

                               IF 'DGFLG

                                   IF 'DGXREF

                                       QUIT

 +22      ;update

 +23                       IF DGS

                               IF DGFLG

                                   SET DGVAL=0

                                   DO UPDR

                                   QUIT

 +24                       IF DGS

                               IF DGXREF

                                   SET DGVAL=0

                                   DO UPDR

                                   QUIT

 +25                       IF 'DGS

                               IF 'DGFLG

                                   SET DGVAL=1

                                   DO UPDR

                                   QUIT

 +26                       IF 'DGS

                               IF 'DGXREF

                                   SET DGVAL=1

                                   DO UPDR

                                   QUIT

                       End DoDot:2

               End DoDot:1

 +27      ;

 +28       DO PRINT

 +29       QUIT

 +30      ;

UPDR      ;

 +1        SET COUNT=COUNT+1

 +2        SET DGFLG=$SELECT(DGFLG:"YES",1:"NO")

 +3        SET DGXREF=$SELECT(DGXREF:"YES",1:"NO")

 +4        SET ^XTMP("DG53P600",$JOB,DFN)=DGSSN_"^"_DGFLG_"^"_DGXREF

 +5        IF 'DGENSKIP

               Begin DoDot:1

 +6                SET DGFDA(2,DFN_",",.6)=DGVAL

 +7                DO FILE^DIE("S","DGFDA","DGERR")

 +8                IF DGVAL=0

                       KILL ^DPT("ATEST",DFN)

               End DoDot:1

 +9        QUIT

PRINT     ;

 +1        USE IO

 +2        NEW DGDDT,DGQUIT,DGPG

 +3        SET DGDDT=$$FMTE^XLFDT($$NOW^XLFDT,"D")

 +4        SET (DGQUIT,DGPG)=0

 +5        DO HEAD

 +6        IF '$GET(COUNT)

               Begin DoDot:1

 +7                WRITE !!!,?20,"*** No records to report ***"

               End DoDot:1

               QUIT

 +8        WRITE !!,"*** COUNT OF BAD PATIENT RECORDS"_$SELECT(DGENSKIP:"",1:" UPDATED")_": ",COUNT," ***",!!

 +9        SET DFN=0

 +10       FOR

               SET DFN=$ORDER(^XTMP("DG53P600",$JOB,DFN))

               IF 'DFN

                   QUIT

               Begin DoDot:1

 +11               IF $Y>(IOSL-4)

                       DO HEAD

 +12               SET DGSSN=$PIECE($GET(^XTMP("DG53P600",$JOB,DFN)),U)

 +13               SET DGFLG=$PIECE($GET(^XTMP("DG53P600",$JOB,DFN)),U,2)

 +14               SET DGXREF=$PIECE($GET(^XTMP("DG53P600",$JOB,DFN)),U,3)

 +15               WRITE ?2,DFN,?15,DGSSN,?37,DGFLG,?56,DGXREF,!

               End DoDot:1

               IF DGQUIT

                   QUIT

 +16      ;

 +17       IF DGQUIT

               IF $DATA(ZTQUEUED)

                   WRITE !!,"Report stopped at user's request"

               QUIT

 +18       IF $GET(DGPG)>0

               IF $EXTRACT(IOST)="C"

                   KILL DIR

                   SET DIR(0)="E"

                   DO ^DIR

                   KILL DIR

                   IF +Y=0

                       SET DGQUIT=1

 +19       IF $DATA(ZTQUEUED)

               SET ZTREQ="@"

 +20       QUIT

 +21      ;

HEAD      ;

 +1        IF $DATA(ZTQUEUED)

               IF $$S^%ZTLOAD

                   SET (ZTSTOP,DGQUIT)=1

                   QUIT

 +2        IF $GET(DGPG)>0

               IF $EXTRACT(IOST)="C"

                   KILL DIR

                   SET DIR(0)="E"

                   DO ^DIR

                   KILL DIR

                   IF +Y=0

                       SET DGQUIT=1

 +3        IF DGQUIT

               QUIT

 +4        SET DGPG=$GET(DGPG)+1

 +5        WRITE @IOF,!,DGDDT,?15,"DG*5.3*600 Patient File Update Utility",?70,"Page:",$JUSTIFY(DGPG,5),!

           KILL X

           SET $PIECE(X,"-",81)=""

           WRITE X,!

 +6        WRITE !

 +7        WRITE !,?2,"DFN",?15,"SSN",?26,"Test Patient Indicator",?50,"'ATEST' crossref",!

 +8        SET $PIECE(X,"-",81)=""

           WRITE X,!

 +9        QUIT

DG53P600.m