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 ---[H[J[2J[HEASXDRUT 1269 printed Oct 16, 2024@17:56:43 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
