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

RMPOLZC.m

Go to the documentation of this file.
  1. RMPOLZC ;EDS/PAK - HOME OXYGEN LETTERS ;7/24/98
  1. ;;3.0;PROSTHETICS;**55**;Feb 09, 1996
  1. ;
  1. ; ODJ - patch 55 - Need to split RMPOLZ as over 10K
  1. ;
  1. Q
  1. ;
  1. LST ; Check Letters List
  1. ; Input:
  1. ; JOB - 1: job, 0: interactive
  1. ; Output:
  1. ; LST(list parameters) - 0: no action
  1. ; 1: use current list
  1. ; 2: create new list
  1. S (RL,RMLSTF,LST)=0,%=2
  1. S RMBAT1=$O(^RMPR(669.9,RMPOXITE,"RMPOXBAT1",0))
  1. S RMBAT2=$O(^RMPR(669.9,RMPOXITE,"RMPOXBAT2",0))
  1. S RMBAT3=$O(^RMPR(669.9,RMPOXITE,"RMPOXBAT3",0))
  1. I $G(RMBAT1)!$G(RMBAT2)!$G(RMBAT3) S RMLSTF=1 ; if already a patient list in existance exit
  1. I JOB S LST=1 Q ; use current list as default if run in background
  1. LST1 I RMLSTF W !,"A list of patient letters to be printed already exists",!,"Do you wish to manage the current list" D YN^DICN
  1. S:%=1 LST=1 S:%=-1 LST=0 S:%=2 RL=2 I %=0 W !,"Answer with 'Y' or 'N' " S %=2 G LST1
  1. LST2 I RL=2 S %=2 W !,"Do you wish to generate a new list which will discard any edits" D YN^DICN S:%=1 LST=1 S:%=2 LST=2 S:%=-1 LST=0 I %=0 W !,"Answer with 'Y' or 'N' " S %=2 G LST2
  1. Q
  1. ;
  1. PURGE ; Purge current patient letter list
  1. S RMPOLTR=0 F S RMPOLTR=$O(^RMPR(665,"ALTR",RMPOLTR)) Q:RMPOLTR="" D
  1. . S RMPODFN=0 F S RMPODFN=$O(^RMPR(665,"ALTR",RMPOLTR,RMPODFN)) Q:RMPODFN="" D UPDLTR^RMPOLZA(RMPODFN,"@")
  1. Q
  1. ;
  1. LTRCR() ; build local array CROSS REFERENCE of H.O. letter Code to Letter
  1. ; ! assumes a letter code can have many letter templates but one !
  1. ; ! template is of a particluar type e.g. a 30,60,90 & 120 Day H.O. !
  1. ; ! letters are all of type "B" : prescription pending expiry. !
  1. ; Input:
  1. ; JOB - 1: job, 0: interactive
  1. ; Output:
  1. ; LTRX("A",Letter Code,Prosthetics Letter IEN)
  1. ; LTRX("B",Prosthetics Letter IEN)=Letter Code
  1. ; LTRX("C",Letter Code)=Prosthetics Letter IEN
  1. ; LTRX("D",Letter Code)=days till expiry (patch 55)
  1. ; ^TMP($J,RMPOXITE,"HEADER",RMPOLTR)= 0: No Letter header
  1. N LTRIEN,REC,HEAD,X1,X2,X,%H,%T,%,%I,RMPONOW
  1. D NOW^%DTC S RMPONOW=X
  1. S LTRIEN=0 F S LTRIEN=$O(^RMPR(669.9,RMPOXITE,"RMPOLET",LTRIEN)) Q:LTRIEN<1 D
  1. . S REC=^RMPR(669.9,RMPOXITE,"RMPOLET",LTRIEN,0)
  1. . ; if run is backgrd and letters are NOT to be autogenerated then do not list
  1. . ; the letter as a valid H.O. letter
  1. . I JOB,'$P(REC,U,4) Q
  1. . S RMPOLTR=$P(REC,U),RMPOLCD=$P(REC,U,2),RMPOGEN=$P(REC,U,4)
  1. . I RMPOLCD=""!(RMPOLTR="")!('$G(RMPOGEN)) Q
  1. . S ^TMP($J,RMPOXITE,"HEADER",RMPOLTR)=$P(REC,U,5)
  1. . S LTRX("A",RMPOLCD,RMPOLTR)="",LTRX("B",RMPOLTR)=RMPOLCD
  1. . S LTRX("C",RMPOLCD)=RMPOLTR
  1. . ;
  1. . ; calc. a date after which prescription expiry dates will
  1. . ; not generate a given letter
  1. . S X1=RMPONOW,X2=$P(REC,U,3) D C^%DTC
  1. . S LTRX("D",RMPOLCD)=X
  1. Q
  1. ;
  1. ; Get active prescription
  1. RXAC(RMPRPAT) ;
  1. N RMPRX,RMPRS,X,%,%H,%I,RMPROK,RMDACT,RMDEXP,TODAY,RMPRIEN
  1. D NOW^%DTC
  1. S TODAY=X
  1. S RMPRIEN=0
  1. S RMPRX=":"
  1. F S RMPRX=$O(^RMPR(665,RMPRPAT,"RMPOB",RMPRX),-1) Q:'+RMPRX D Q:RMPRIEN
  1. . S RMPRS=^RMPR(665,RMPRPAT,"RMPOB",RMPRX,0)
  1. . S RMDACT=$P(RMPRS,"^",1)
  1. . S RMDEXP=$P(RMPRS,"^",3)
  1. . I RMDACT'="",RMDACT'>TODAY D
  1. .. I RMDEXP="" S RMPRIEN=RMPRX Q
  1. .. I RMDEXP>TODAY S RMPRIEN=RMPRX Q
  1. .. Q
  1. . Q
  1. Q RMPRIEN