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