EASXDRUT.m

EASXDRUT ;ALB/AEG - Duplicate Patient Relations Utilities ;7-12-02

 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**10**;Mar 15, 2002

 ;

TEXT ; Print Screen Text upon Entry into the option.

 N TEX,I F I=1:1 S TEX=$P($T(DESC+I),";;",2) Q:TEX="QUIT"  D

 .I I'>2 W !,?17,TEX

 .E  W !,?3,TEX

 K I,X

 Q

 ;

DESC ; Text to be printed upon entry into the option.

 ;;*** DUPLICATE PATIENT RELATIONS REPORT ***

 ;;

 ;;This report will search the PATIENT RELATION file (#408.12) to identify

 ;;those entries where potential duplicates exist.

 ;;

 ;;This report is designed for an 80 column print device or a terminal

 ;;using the HOME device.  The report may take a long time to generate,

 ;;accordingly, it is recommended that it be queued to an 80 column

 ;;print device.  The P-MESSAGE device is NOT recommended for use, nor

 ;;should the output format be specified at the device prompt in order to 

 ;;do a screen capture.

 ;;QUIT

 ;

SETUP ; Setup output variables based on terminal type.

 S COL1=0

 S COL2=11

 S COL3=38

 S COL4=48

 S COL5=58

 S COL6=63

 S COL7=74

 S $P(EQL,"=",IOM)=""

 S $P(DAL,"-",IOM)=""

 Q

 ;

PAUSE ;

 N IY,ZZ

 S ZZ=$Y

 I $E(IOST,1,2)="C-" D

 .F IY=ZZ:1:(IOSL-4) W !

 .K DIR,DIRUT

 .S DIR(0)="E"

 .D ^DIR

 .;W @IOF

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---EASXDRUT   1269     printed  Apr 23, 2025@18:10:25                                                                                                                                                                                                    Page 2

EASXDRUT  ;ALB/AEG - Duplicate Patient Relations Utilities ;7-12-02

 +1       ;;1.0;ENROLLMENT APPLICATION SYSTEM;**10**;Mar 15, 2002

 +2       ;

TEXT      ; Print Screen Text upon Entry into the option.

 +1        NEW TEX,I

           FOR I=1:1

               SET TEX=$PIECE($TEXT(DESC+I),";;",2)

               if TEX="QUIT"

                   QUIT 

               Begin DoDot:1

 +2                IF I'>2

                       WRITE !,?17,TEX

 +3               IF '$TEST

                       WRITE !,?3,TEX

               End DoDot:1

 +4        KILL I,X

 +5        QUIT 

 +6       ;

DESC      ; Text to be printed upon entry into the option.

 +1       ;;*** DUPLICATE PATIENT RELATIONS REPORT ***

 +2       ;;

 +3       ;;This report will search the PATIENT RELATION file (#408.12) to identify

 +4       ;;those entries where potential duplicates exist.

 +5       ;;

 +6       ;;This report is designed for an 80 column print device or a terminal

 +7       ;;using the HOME device.  The report may take a long time to generate,

 +8       ;;accordingly, it is recommended that it be queued to an 80 column

 +9       ;;print device.  The P-MESSAGE device is NOT recommended for use, nor

 +10      ;;should the output format be specified at the device prompt in order to 

 +11      ;;do a screen capture.

 +12      ;;QUIT

 +13      ;

SETUP     ; Setup output variables based on terminal type.

 +1        SET COL1=0

 +2        SET COL2=11

 +3        SET COL3=38

 +4        SET COL4=48

 +5        SET COL5=58

 +6        SET COL6=63

 +7        SET COL7=74

 +8        SET $PIECE(EQL,"=",IOM)=""

 +9        SET $PIECE(DAL,"-",IOM)=""

 +10       QUIT 

 +11      ;

PAUSE     ;

 +1        NEW IY,ZZ

 +2        SET ZZ=$Y

 +3        IF $EXTRACT(IOST,1,2)="C-"

               Begin DoDot:1

 +4                FOR IY=ZZ:1:(IOSL-4)

                       WRITE !

 +5                KILL DIR,DIRUT

 +6                SET DIR(0)="E"

 +7                DO ^DIR

 +8       ;W @IOF

               End DoDot:1

 +9        QUIT