Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RMPOLET1

RMPOLET1.m

Go to the documentation of this file.
  1. RMPOLET1 ;EDS/PAK - HOME OXYGEN LETTERS ;7/24/98
  1. ;;3.0;PROSTHETICS;**29**;Feb 09, 1996
  1. ;
  1. PRINT(ANS) ; print listing of patient letters to be generated.
  1. S %ZIS="Q" D ^%ZIS Q:POP=1
  1. I $D(IO("Q")) D Q:'$$QUEUE("RMPO : Patient Letter List","START^RMPOLET1",.ZTSAVE) D HOME^%ZIS Q
  1. . K ZTSAVE S (ZTSAVE("^TMP($J,"),ZTSAVE("RMPOXITE"),ZTSAVE("ANS"),ZTSAVE("LTRX("))=""
  1. ;
  1. START ;
  1. N ANSW,NAME,LINE,SP
  1. ;
  1. S $P(LINE,"-",80)="",$P(SP," ",80)=" "
  1. ; Get letter code description
  1. S RMPOLCD="" F S RMPOLCD=$O(LTRX("A",RMPOLCD)) Q:RMPOLCD="" S HEAD(RMPOLCD)=$$EXTERNAL^DILFD(669.965,1,"",RMPOLCD)
  1. ;
  1. U IO(0) S ANSW=""
  1. I "Aa"[ANS S RMPOLCD=0 F S RMPOLCD=$O(^TMP($J,"RMPOLST",RMPOLCD)) Q:RMPOLCD="" D
  1. . D HEADER
  1. . S RMPODFN="" F S RMPODFN=$O(^TMP($J,"RMPOLST",RMPOLCD,RMPODFN)) Q:RMPODFN=""!(ANSW="^") D LINE
  1. E S RMPOLCD=ANS,RMPODFN="" F S RMPODFN=$O(^TMP($J,"RMPOLST",RMPOLCD,RMPODFN)) Q:RMPODFN=""!(ANSW="^") D LINE
  1. Q:ANS="^"
  1. I IOST["C-" R !?20,"Enter <RETURN> to continue",ANSW:DTIME Q:'$T
  1. Q
  1. ;
  1. LINE ;
  1. N REC
  1. ;
  1. S RMPOLTR=^TMP($J,"RMPOLST",RMPOLCD,RMPODFN),LTR=$P(^RMPR(665.2,RMPOLTR,0),U)
  1. S REC=^TMP($J,"RMPODEMO",RMPODFN)
  1. S RMPOITEM=$P(REC,U,5) S:RMPOITEM="" RMPOITEM="No Primary!"
  1. W !,$E($P(REC,U),1,27),?28,$P(REC,U,2),?41,$E(RMPOITEM,1,12)
  1. S Y=$P(REC,U,3) D DD^%DT W ?54,Y
  1. S Y=$P(REC,U,4)
  1. I Y'="" D DD^%DT
  1. I Y="" S Y="No Rx!"
  1. W ?68,Y
  1. ;
  1. D UPDLTR^RMPOLET0(RMPODFN,LTR) ; update "letter to be sent"
  1. ;
  1. 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
  1. Q
  1. N TITLE
  1. ;
  1. S TITLE="'"_HEAD(RMPOLCD)_"' letter Patient List"
  1. W @IOF,!,$E(SP,1,(80-$L(TITLE)/2))_TITLE,!!,"Name",?28,"SSN",?41,"Primary Item",?54,"Activation",?68,"Expiry Date",!,?54,"Date",!,LINE
  1. Q
  1. DELETE ;deletes patient from the batch printing list
  1. Q:'$$SITE^RMPOLET0
  1. ;
  1. ; attempt to lock virtual letter print record
  1. L +^TMP("RMPO",$J,"LETTERPRINT"):0
  1. I '$T W !,"You may delete after listing and before printing." H 3 D EXIT Q
  1. ;
  1. ;
  1. GLTR ;ask for patients letter to be deleted from printing
  1. N STA,Y,DA
  1. ;
  1. S RMPOLTR=""
  1. F S RMPOLTR=$O(^RMPR(665,"ALTR",RMPOLTR)) Q:RMPOLTR="" D Q:'$G(RMPODFN)
  1. . S DA=$$GPAT
  1. . D:DA UPDLTR^RMPOLET0(DA,"@")
  1. D EXIT
  1. Q
  1. ;
  1. GPAT() ; select only patinet with specified letters pending
  1. S DIC("S")="I $D(^RMPR(665,""ALTR"","_RMPOLTR_",Y))"
  1. S DIC="^RMPR(665,",DIC(0)="QEAM"
  1. S DIC("A")="Enter the patient to delete from printing: "
  1. D ^DIC K DIC I Y'>0 Q 0
  1. S RMPODFN=$P(Y,U)
  1. Q RMPODFN
  1. EXIT ;
  1. L -^TMP("RMPO",$J,"LETTERPRINT")
  1. D ^%ZISC
  1. W !!,"DONE !!"
  1. K DIC,RMPO,DEL
  1. Q
  1. ;
  1. QUEUE(ZTDESC,ZTRTN,ZTSAVE) ; Queue print
  1. D ^%ZTLOAD
  1. I '$D(ZTSK) W !!,?5,"Report Cancelled!",! Q 0
  1. E W !!,?5,"Print queued!",! Q 1
  1. Q