RMPOLET1 ;EDS/PAK - HOME OXYGEN LETTERS ;7/24/98
;;3.0;PROSTHETICS;**29**;Feb 09, 1996
;
PRINT(ANS) ; print listing of patient letters to be generated.
S %ZIS="Q" D ^%ZIS Q:POP=1
I $D(IO("Q")) D Q:'$$QUEUE("RMPO : Patient Letter List","START^RMPOLET1",.ZTSAVE) D HOME^%ZIS Q
. K ZTSAVE S (ZTSAVE("^TMP($J,"),ZTSAVE("RMPOXITE"),ZTSAVE("ANS"),ZTSAVE("LTRX("))=""
;
START ;
N ANSW,NAME,LINE,SP
;
S $P(LINE,"-",80)="",$P(SP," ",80)=" "
; Get letter code description
S RMPOLCD="" F S RMPOLCD=$O(LTRX("A",RMPOLCD)) Q:RMPOLCD="" S HEAD(RMPOLCD)=$$EXTERNAL^DILFD(669.965,1,"",RMPOLCD)
;
U IO(0) S ANSW=""
I "Aa"[ANS S RMPOLCD=0 F S RMPOLCD=$O(^TMP($J,"RMPOLST",RMPOLCD)) Q:RMPOLCD="" D
. D HEADER
. S RMPODFN="" F S RMPODFN=$O(^TMP($J,"RMPOLST",RMPOLCD,RMPODFN)) Q:RMPODFN=""!(ANSW="^") D LINE
E S RMPOLCD=ANS,RMPODFN="" F S RMPODFN=$O(^TMP($J,"RMPOLST",RMPOLCD,RMPODFN)) Q:RMPODFN=""!(ANSW="^") D LINE
Q:ANS="^"
I IOST["C-" R !?20,"Enter <RETURN> to continue",ANSW:DTIME Q:'$T
Q
;
LINE ;
N REC
;
S RMPOLTR=^TMP($J,"RMPOLST",RMPOLCD,RMPODFN),LTR=$P(^RMPR(665.2,RMPOLTR,0),U)
S REC=^TMP($J,"RMPODEMO",RMPODFN)
S RMPOITEM=$P(REC,U,5) S:RMPOITEM="" RMPOITEM="No Primary!"
W !,$E($P(REC,U),1,27),?28,$P(REC,U,2),?41,$E(RMPOITEM,1,12)
S Y=$P(REC,U,3) D DD^%DT W ?54,Y
S Y=$P(REC,U,4)
I Y'="" D DD^%DT
I Y="" S Y="No Rx!"
W ?68,Y
;
D UPDLTR^RMPOLET0(RMPODFN,LTR) ; update "letter to be sent"
;
I IOST["C-",($Y+6)>IOSL W !!?20,"Enter <RETURN> to continue or '^' to quit" R ANSW:DTIME S:'$T!(ANSW="^") ANSW="^" D:ANSW'="^" HEADER
Q
N TITLE
;
S TITLE="'"_HEAD(RMPOLCD)_"' letter Patient List"
W @IOF,!,$E(SP,1,(80-$L(TITLE)/2))_TITLE,!!,"Name",?28,"SSN",?41,"Primary Item",?54,"Activation",?68,"Expiry Date",!,?54,"Date",!,LINE
Q
DELETE ;deletes patient from the batch printing list
Q:'$$SITE^RMPOLET0
;
; attempt to lock virtual letter print record
L +^TMP("RMPO",$J,"LETTERPRINT"):0
I '$T W !,"You may delete after listing and before printing." H 3 D EXIT Q
;
;
GLTR ;ask for patients letter to be deleted from printing
N STA,Y,DA
;
S RMPOLTR=""
F S RMPOLTR=$O(^RMPR(665,"ALTR",RMPOLTR)) Q:RMPOLTR="" D Q:'$G(RMPODFN)
. S DA=$$GPAT
. D:DA UPDLTR^RMPOLET0(DA,"@")
D EXIT
Q
;
GPAT() ; select only patinet with specified letters pending
S DIC("S")="I $D(^RMPR(665,""ALTR"","_RMPOLTR_",Y))"
S DIC="^RMPR(665,",DIC(0)="QEAM"
S DIC("A")="Enter the patient to delete from printing: "
D ^DIC K DIC I Y'>0 Q 0
S RMPODFN=$P(Y,U)
Q RMPODFN
EXIT ;
L -^TMP("RMPO",$J,"LETTERPRINT")
D ^%ZISC
W !!,"DONE !!"
K DIC,RMPO,DEL
Q
;
QUEUE(ZTDESC,ZTRTN,ZTSAVE) ; Queue print
D ^%ZTLOAD
I '$D(ZTSK) W !!,?5,"Report Cancelled!",! Q 0
E W !!,?5,"Print queued!",! Q 1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPOLET1 2823 printed Oct 16, 2024@18:31:35 Page 2
RMPOLET1 ;EDS/PAK - HOME OXYGEN LETTERS ;7/24/98
+1 ;;3.0;PROSTHETICS;**29**;Feb 09, 1996
+2 ;
PRINT(ANS) ; print listing of patient letters to be generated.
+1 SET %ZIS="Q"
DO ^%ZIS
if POP=1
QUIT
+2 IF $DATA(IO("Q"))
Begin DoDot:1
+3 KILL ZTSAVE
SET (ZTSAVE("^TMP($J,"),ZTSAVE("RMPOXITE"),ZTSAVE("ANS"),ZTSAVE("LTRX("))=""
End DoDot:1
if '$$QUEUE("RMPO
QUIT
DO HOME^%ZIS
QUIT
+4 ;
START ;
+1 NEW ANSW,NAME,LINE,SP
+2 ;
+3 SET $PIECE(LINE,"-",80)=""
SET $PIECE(SP," ",80)=" "
+4 ; Get letter code description
+5 SET RMPOLCD=""
FOR
SET RMPOLCD=$ORDER(LTRX("A",RMPOLCD))
if RMPOLCD=""
QUIT
SET HEAD(RMPOLCD)=$$EXTERNAL^DILFD(669.965,1,"",RMPOLCD)
+6 ;
+7 USE IO(0)
SET ANSW=""
+8 IF "Aa"[ANS
SET RMPOLCD=0
FOR
SET RMPOLCD=$ORDER(^TMP($JOB,"RMPOLST",RMPOLCD))
if RMPOLCD=""
QUIT
Begin DoDot:1
+9 DO HEADER
+10 SET RMPODFN=""
FOR
SET RMPODFN=$ORDER(^TMP($JOB,"RMPOLST",RMPOLCD,RMPODFN))
if RMPODFN=""!(ANSW="^")
QUIT
DO LINE
End DoDot:1
+11 IF '$TEST
SET RMPOLCD=ANS
SET RMPODFN=""
FOR
SET RMPODFN=$ORDER(^TMP($JOB,"RMPOLST",RMPOLCD,RMPODFN))
if RMPODFN=""!(ANSW="^")
QUIT
DO LINE
+12 if ANS="^"
QUIT
+13 IF IOST["C-"
READ !?20,"Enter <RETURN> to continue",ANSW:DTIME
if '$TEST
QUIT
+14 QUIT
+15 ;
LINE ;
+1 NEW REC
+2 ;
+3 SET RMPOLTR=^TMP($JOB,"RMPOLST",RMPOLCD,RMPODFN)
SET LTR=$PIECE(^RMPR(665.2,RMPOLTR,0),U)
+4 SET REC=^TMP($JOB,"RMPODEMO",RMPODFN)
+5 SET RMPOITEM=$PIECE(REC,U,5)
if RMPOITEM=""
SET RMPOITEM="No Primary!"
+6 WRITE !,$EXTRACT($PIECE(REC,U),1,27),?28,$PIECE(REC,U,2),?41,$EXTRACT(RMPOITEM,1,12)
+7 SET Y=$PIECE(REC,U,3)
DO DD^%DT
WRITE ?54,Y
+8 SET Y=$PIECE(REC,U,4)
+9 IF Y'=""
DO DD^%DT
+10 IF Y=""
SET Y="No Rx!"
+11 WRITE ?68,Y
+12 ;
+13 ; update "letter to be sent"
DO UPDLTR^RMPOLET0(RMPODFN,LTR)
+14 ;
+15 IF IOST["C-"
IF ($Y+6)>IOSL
WRITE !!?20,"Enter <RETURN> to continue or '^' to quit"
READ ANSW:DTIME
if '$TEST!(ANSW="^")
SET ANSW="^"
if ANSW'="^"
DO HEADER
+16 QUIT
+1 NEW TITLE
+2 ;
+3 SET TITLE="'"_HEAD(RMPOLCD)_"' letter Patient List"
+4 WRITE @IOF,!,$EXTRACT(SP,1,(80-$LENGTH(TITLE)/2))_TITLE,!!,"Name",?28,"SSN",?41,"Primary Item",?54,"Activation",?68,"Expiry Date",!,?54,"Date",!,LINE
+5 QUIT
DELETE ;deletes patient from the batch printing list
+1 if '$$SITE^RMPOLET0
QUIT
+2 ;
+3 ; attempt to lock virtual letter print record
+4 LOCK +^TMP("RMPO",$JOB,"LETTERPRINT"):0
+5 IF '$TEST
WRITE !,"You may delete after listing and before printing."
HANG 3
DO EXIT
QUIT
+6 ;
+7 ;
GLTR ;ask for patients letter to be deleted from printing
+1 NEW STA,Y,DA
+2 ;
+3 SET RMPOLTR=""
+4 FOR
SET RMPOLTR=$ORDER(^RMPR(665,"ALTR",RMPOLTR))
if RMPOLTR=""
QUIT
Begin DoDot:1
+5 SET DA=$$GPAT
+6 if DA
DO UPDLTR^RMPOLET0(DA,"@")
End DoDot:1
if '$GET(RMPODFN)
QUIT
+7 DO EXIT
+8 QUIT
+9 ;
GPAT() ; select only patinet with specified letters pending
+1 SET DIC("S")="I $D(^RMPR(665,""ALTR"","_RMPOLTR_",Y))"
+2 SET DIC="^RMPR(665,"
SET DIC(0)="QEAM"
+3 SET DIC("A")="Enter the patient to delete from printing: "
+4 DO ^DIC
KILL DIC
IF Y'>0
QUIT 0
+5 SET RMPODFN=$PIECE(Y,U)
+6 QUIT RMPODFN
EXIT ;
+1 LOCK -^TMP("RMPO",$JOB,"LETTERPRINT")
+2 DO ^%ZISC
+3 WRITE !!,"DONE !!"
+4 KILL DIC,RMPO,DEL
+5 QUIT
+6 ;
QUEUE(ZTDESC,ZTRTN,ZTSAVE) ; Queue print
+1 DO ^%ZTLOAD
+2 IF '$DATA(ZTSK)
WRITE !!,?5,"Report Cancelled!",!
QUIT 0
+3 IF '$TEST
WRITE !!,?5,"Print queued!",!
QUIT 1
+4 QUIT
