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

RMPOLZA.m

Go to the documentation of this file.
  1. RMPOLZA ;EDS/PAK - HOME OXYGEN LETTERS ;5/27/03 10:34
  1. ;;3.0;PROSTHETICS;**29,77**;Feb 09, 1996
  1. ;
  1. ;RVD patch #77 - insure that dangling 'AC' x-ref will not cause
  1. ; the undefined error.
  1. ;
  1. QUIT() ;
  1. ; Input: None
  1. ; Output:
  1. ; Quit flag - 1: time out on read
  1. ; 0: no time out on read
  1. ;
  1. Q ($D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT))
  1. ;
  1. SITE(RMPRSITE) ;find the site if the site is not multidivisional
  1. ;
  1. ; Input:
  1. ; Prosthetics Site - valid site ID held in file 669.9
  1. ; Output:
  1. ; Site flag - 0: no H.O. site selected
  1. ; 1: H.O. site selected
  1. ;
  1. ; Non interactive call to pull site parameters if site supplied
  1. I RMPRSITE'="" D ^RMPRSIT M RMPO=RMPR S RMPOSITE=RMPO("STA") Q 1
  1. ;
  1. ; Interactive call requiring operator input
  1. D HOSITE^RMPOUTL0 Q:$G(QUIT) 0 ; output RMPO("STA") - station number
  1. W @IOF K ^TMP($J)
  1. I '$G(RMPOREC) W !!,*7,"You must choose a Home Oxygen Site.",!! Q 0
  1. S RMPOXITE=RMPOREC
  1. Q 1
  1. ;
  1. EXTRCT ; Extract patient demographics
  1. ;
  1. ; Input:
  1. ; RMPODFN - Patient IEN to NEW PERSON file
  1. ; ADT - Patient Rx activation date
  1. ; Output:
  1. ; ^TMP($J,RMPOXITE,"RMPODEMO",RMPODFN) - LastName,FirstName^H.O. ActivateDate^
  1. ; Rx Expiry Date^PrimaryItemName^Prescription^PrescriptionDate^TodaysDate^
  1. ; ^Sex^AddressLine1^AddressLine2^AddressLine3^City^State^Zip
  1. ;
  1. ; quit if already generated demographic details for a patient
  1. Q:$D(^TMP($J,RMPOXITE,"RMPODEMO",RMPODFN))
  1. ;
  1. N INAME,DFN,VAPA,INFO
  1. ;
  1. S INAME="",DFN=RMPODFN
  1. K VADM D DEM^VADPT,ADD^VADPT
  1. ;
  1. ; if patient has an active prescription get date entered & expiry date else set dates = NULL
  1. I RMPORX'="",$D(^RMPR(665,RMPODFN,"RMPOB",RMPORX,0)) S RMPOEXP=$P(^RMPR(665,RMPODFN,"RMPOB",RMPORX,0),U,3),RMPORXDT=$P(^(0),U)
  1. E S (RMPOEXP,RMPORXDT)=""
  1. ;
  1. ; get primary item
  1. S INAME="",RMPOITEM=$O(^RMPR(665,"AC","Y",RMPODFN,0))
  1. I RMPOITEM'="" D
  1. . Q:'$D(^RMPR(665,RMPODFN,"RMPOC",RMPOITEM,0))
  1. . S RMPOITEM=$P(^RMPR(665,RMPODFN,"RMPOC",RMPOITEM,0),U),RMPOITEM=$P(^RMPR(661,RMPOITEM,0),U)
  1. . S INAME=$P(^PRC(441,RMPOITEM,0),U,2)
  1. ;
  1. ;set the ^TMP($J,RMPOXITE,"RMPODEMO" global with patient demographics
  1. S INFO=VADM(1)_U_$P(VADM(2),U,2)_U_ADT_U_RMPOEXP_U_INAME
  1. S INFO=INFO_U_RMPORX_U_RMPORXDT_U_DT_U_$P(VADM(5),U)_U_VAPA(1)_U_VAPA(2)_U_VAPA(3)_U_VAPA(4)_U_$P(VAPA(5),U,2)_U_VAPA(6)
  1. S ^TMP($J,RMPOXITE,"RMPODEMO",RMPODFN)=INFO Q:'$D(RMPOLCD)!RMPOLCD=""
  1. Q
  1. ;
  1. LOCK() ; lock virtual list record
  1. ;
  1. ; Input:
  1. ; JOB - 1: job, 2: interactive
  1. ;
  1. ; Output:
  1. ; None
  1. ;
  1. L +^TMP("RMPO",$J,RMPOXITE,"LETTERPRINT"):0
  1. I '$T W:'JOB !,"Cannot continue as list edit or printing is in progress" H 2 Q 0
  1. Q 1
  1. ;
  1. UPDLTR(DA,VAL) ; Update 'Letter to be sent' in Prosthetics Patient File
  1. ;
  1. ; I/P :
  1. ; VAL - value to be inserted into field
  1. ;
  1. N DIE
  1. ;
  1. S DR="19.13///"_VAL,DIE="^RMPR(665," D ^DIE
  1. Q
  1. ;
  1. SELN(TYP,TXT,MAX) ;
  1. ;
  1. ; Input:
  1. ; TYP(e) - section type: "L"ist of #
  1. ; single "N"umber
  1. ; TeXT - prompt text
  1. ; MAX - maximum valid number
  1. ;
  1. ; Output:
  1. ; Y - selected number or range of numbers
  1. ;
  1. N DIR,Y
  1. ;
  1. D FULL^VALM1
  1. S DIR("A")=TXT,DIR(0)=TYP_"^1:"_MAX_":0"
  1. D ^DIR
  1. Q:$$QUIT^RMPOLZA 0
  1. I Y="" S VALMBCK="R",Y=0
  1. Q Y