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