- 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 Jan 18, 2025@03:32:05 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