RMPOLET0 ;EDS/PAK - HOME OXYGEN LETTERS ;7/24/98
;;3.0;PROSTHETICS;**29,46**;Feb 09, 1996
;
START ;
N LST,TXT,TRXS,LTRX
;
Q:'$$SITE
S LST=$$LST I 'LST G EXIT
D:LST=2 PURGE
D LTRCR ; generate letter code to prosthetics letter IEN xref
K ^TMP($J)
; build patient list work file from current list (GENOLST) or
; generate new patient letter list work file (GENLST)
D GENLST:LST'=1,GENOLST(0):LST=1
;
D SELECT^RMPOLETA
;
L -^TMP("RMPO","LETTERPRINT")
G EXIT
Q
;
SITE() ;find the site if the site is not multidivisional
;
;Initialize, if necessary
D HOSITE^RMPOUTL0 ; 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
;
LST() ;Check Letters List
N LST
;
S LST=0
I $D(^RMPR(665,"ALTR")) D ; if already a patient list in existance exit
. S %=2
. W !,"A list of patient letters to be printed already exists",!
. W !,"Do you wish to reprint the current list" D YN^DICN
. I %=1 S LST=1
. E S %=2 W !,"Do you wish to generate a new list which will discard any edits" D YN^DICN S:%=1 LST=2
E S LST=3
I LST S TXT=$S(LST=1:"work with current",LST=2:"regenerate",1:"generate new") S:'$$LOCK(TXT) LST=0
Q LST
;
LTRCR ; build local array CROSS REFERENCE of H.O. letter Code to Letter
;
; ! assumes a letter code can have many letter templates but one !
; ! template is of a particluar type e.g. a 30,60,90 & 120 Day H.O. !
; ! letters are all of type "B" : prescription pending expiry. !
;
; O/P : LTRX("A",Letter Code,Prosthetics Letter IEN)
; LTRX("B",Prosthetics Letter IEN)=Letter Code
;
N LTRIEN,REC
;
S LTRIEN=0 F S LTRIEN=$O(^RMPR(669.9,RMPOXITE,"RMPOLET",LTRIEN)) Q:LTRIEN<1 D
. S REC=^RMPR(669.9,RMPOXITE,"RMPOLET",LTRIEN,0),RMPOLTR=$P(REC,U),RMPOLCD=$P(REC,U,2)
. I RMPOLCD'="",(RMPOLTR'="") S LTRX("A",RMPOLCD,RMPOLTR)="",LTRX("B",RMPOLTR)=RMPOLCD
Q
;
GENLST ; generate patient letter list
N REC,ADT,IADT
;
S Z=""
F S Z=$O(^RMPR(665,"AHO",Z)) Q:Z="" D
.S RMPODFN=0
. F S RMPODFN=$O(^RMPR(665,"AHO",Z,RMPODFN)) Q:RMPODFN="" D
.. N TRXS
.. ;
.. Q:$P(^RMPR(665,RMPODFN,"RMPOA"),U,7)'=RMPOXITE ; ignore patient from another station
.. ;Get patient demographic data
.. S DFN=RMPODFN K VADM D DEM^VADPT
.. ;Do not collect patient if expired
.. Q:$G(VADM(6))
.. S REC=$G(^RMPR(665,RMPODFN,"RMPOA")) Q:REC="" ; not a H.O. patient
.. S ADT=$P(REC,U,2),IADT=$P(REC,U,3) ; get Activation & InActivation DaTes
.. Q:ADT="" ; quit if not an active H.O. patient
.. D FNDTRX ; build Xref of transactions (TRX) to letter type for this patient
.. S RMPORX=$P($G(^RMPR(665,RMPODFN,"RMPOB",0)),U,3) ; get active prescription
.. ; check if new patient or inactivation letter required
.. Q:$$NACT
.. ; get active patient prescription and evaluate letter requirement
.. Q:'$D(^RMPR(665,RMPODFN,"RMPOB",0))
.. Q:RMPORX<1 ; quit if no active prescription
.. D EXPR
Q
;
GENOLST(BTYP) ; Generate work file from current patient letter list
N LTRIEN
;
S RMPOLTR=0 F S RMPOLTR=$O(^RMPR(665,"ALTR",RMPOLTR)) Q:RMPOLTR="" D
. S RMPODFN=0 F S RMPODFN=$O(^RMPR(665,"ALTR",RMPOLTR,RMPODFN)) Q:RMPODFN="" D
. . S STA=$P(^RMPR(665,RMPODFN,0),U,2) Q:STA'=RMPO("STA") ; ignore patients from another station
. . S REC=$G(^RMPR(665,RMPODFN,"RMPOA")),ADT=$P(REC,U,2),IADT=$P(REC,U,3)
. . S RMPORX=$P($G(^RMPR(665,RMPODFN,"RMPOB",0)),U,3)
. . S LTRIEN=$O(^RMPR(669.9,RMPOXITE,"RMPOLET","B",RMPOLTR,0))
. . S RMPOLCD=$P(^RMPR(669.9,RMPOXITE,"RMPOLET",LTRIEN,0),U,2)
. . D EXTRCT(BTYP) S ^TMP($J,"RMPOLST",RMPOLCD,RMPODFN)=RMPOLTR
Q
;
NACT() ; check if new patient letter or inactivation letter is required
N FND,LST,DTE
;
F RMPOLCD="A","C" D Q:LST ; Quit if letter placed on list
. S (LST,FND)=0,RMPOLTR="",DTE=$S(RMPOLCD="A":ADT,1:IADT)
. F S RMPOLTR=$O(LTRX("A",RMPOLCD,RMPOLTR)) Q:RMPOLTR="" D Q:FND Q:LST ; for each VALID H.O. letter of given Letter Code
. . I $O(TRXS(RMPOLCD,RMPOLTR,(DTE-1))) S FND=1 Q ; quit if letter printed on or after de/activation
. . D EXTRCT(0) S ^TMP($J,"RMPOLST",RMPOLCD,RMPODFN)=RMPOLTR S LST=1 ; add person to list as requiring appropriate letter
Q FND
;
EXPR ; check if prescription is pending expiry
N REC,LTR,EXP
;
S RMPOLCD="B",REC=^RMPR(665,RMPODFN,"RMPOB",RMPORX,0)
S RMPOEXP=$P(REC,U,3) Q:RMPOEXP<DT ; quit if prescription already expired
S X1=RMPOEXP,X2=DT D ^%DTC S RMPODAYS=X-1
S RMPODAYS=$O(^RMPR(669.9,"ALTDY",RMPODAYS))
Q:RMPODAYS="" ;no letter for this expiry pending period (zero to n days)
Q:'$D(^RMPR(669.9,"ALTDY",RMPODAYS,RMPOXITE)) ; ignore letters defined for other sites
S LTR=$O(^RMPR(669.9,"ALTDY",RMPODAYS,RMPOXITE,0)) ;get FIRST letter assoc. with this expiry period
S RMPOLTR=$P(^RMPR(669.9,RMPOXITE,"RMPOLET",LTR,0),U) ; get H.O. letter
Q:$D(TRXS(RMPOLCD,RMPOLTR)) ; H.O. letter for this expiry period has been sent
D EXTRCT(0) S ^TMP($J,"RMPOLST",RMPOLCD,RMPODFN)=RMPOLTR
Q
;
EXTRCT(BTYP) ;
;
; I/P : Build TYPe - 0=List, 1=Letter
;
; quit if already generated demographic details for a patient
Q:$D(^TMP($J,"RMPODEMO",RMPODFN))
;
N INAME,INFO
;
S INAME="",DFN=RMPODFN
K VADM D DEM^VADPT,ADD^VADPT
S NAME=VADM(1)_U_RMPODFN
;
; if patient has an active prescription get date entered & expiry date else set dates = NULL
I RMPORX'="" 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
. 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,"RMPODEMO" global with patient demographics
S INFO=VADM(1)_U_$P(VADM(2),U,2)_U_ADT_U_RMPOEXP_U_INAME
S:BTYP=1 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,"RMPODEMO",RMPODFN)=INFO
Q
FNDTRX ; find letter TRX & hold in local array
;
; I/P : NONE
; O/P : TRXS(H.O. Letter Code,Prosthetics Letter,Transaction Printed Date)
;
N TRX
;
S TRX=0 F S TRX=$O(^RMPR(665.4,"B",RMPODFN,TRX)) Q:TRX="" D
.
. Q:$P(^RMPR(665.4,TRX,0),U,6)'=RMPO("STA") ; ignore letters from a different station
. S RMPOLTR=$P(^RMPR(665.4,TRX,0),U,2) Q:'$D(LTRX("B",RMPOLTR)) ; ignore if not a H.O. letter transaction
. S RMPOLCD=LTRX("B",RMPOLTR) ; get H.O. Letter Code given H.O. Letter #
. S TRXS(RMPOLCD,RMPOLTR,$P(^RMPR(665.4,TRX,0),U,3))="" ; create local array
Q
;
PURGE ; Purge current patient letter list
S RMPOLTR=0 F S RMPOLTR=$O(^RMPR(665,"ALTR",RMPOLTR)) Q:RMPOLTR="" D
. S RMPODFN=0 F S RMPODFN=$O(^RMPR(665,"ALTR",RMPOLTR,RMPODFN)) Q:RMPODFN="" D UPDLTR(RMPODFN,"@")
Q
;
LOCK(TXT) ;
; lock virtual list record
L +^TMP("RMPO","LETTERPRINT"):0 I '$T W !,"Cannot "_TXT_" list as list edit or printing is in progress" 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
;
S DR="19.13///"_VAL,DIE="^RMPR(665," D ^DIE
Q
;
EXIT G EXIT^RMPOLETA
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPOLET0 7319 printed Apr 09, 2024@21:37:21 Page 2
RMPOLET0 ;EDS/PAK - HOME OXYGEN LETTERS ;7/24/98
+1 ;;3.0;PROSTHETICS;**29,46**;Feb 09, 1996
+2 ;
START ;
+1 NEW LST,TXT,TRXS,LTRX
+2 ;
+3 if '$$SITE
QUIT
+4 SET LST=$$LST
IF 'LST
GOTO EXIT
+5 if LST=2
DO PURGE
+6 ; generate letter code to prosthetics letter IEN xref
DO LTRCR
+7 KILL ^TMP($JOB)
+8 ; build patient list work file from current list (GENOLST) or
+9 ; generate new patient letter list work file (GENLST)
+10 if LST'=1
DO GENLST
if LST=1
DO GENOLST(0)
+11 ;
+12 DO SELECT^RMPOLETA
+13 ;
+14 LOCK -^TMP("RMPO","LETTERPRINT")
+15 GOTO EXIT
+16 QUIT
+17 ;
SITE() ;find the site if the site is not multidivisional
+1 ;
+2 ;Initialize, if necessary
+3 ; output RMPO("STA") - station number
DO HOSITE^RMPOUTL0
+4 WRITE @IOF
KILL ^TMP($JOB)
+5 IF '$GET(RMPOREC)
WRITE !!,*7,"You must choose a Home Oxygen Site.",!!
QUIT 0
+6 SET RMPOXITE=RMPOREC
+7 QUIT 1
+8 ;
LST() ;Check Letters List
+1 NEW LST
+2 ;
+3 SET LST=0
+4 ; if already a patient list in existance exit
IF $DATA(^RMPR(665,"ALTR"))
Begin DoDot:1
+5 SET %=2
+6 WRITE !,"A list of patient letters to be printed already exists",!
+7 WRITE !,"Do you wish to reprint the current list"
DO YN^DICN
+8 IF %=1
SET LST=1
+9 IF '$TEST
SET %=2
WRITE !,"Do you wish to generate a new list which will discard any edits"
DO YN^DICN
if %=1
SET LST=2
End DoDot:1
+10 IF '$TEST
SET LST=3
+11 IF LST
SET TXT=$SELECT(LST=1:"work with current",LST=2:"regenerate",1:"generate new")
if '$$LOCK(TXT)
SET LST=0
+12 QUIT LST
+13 ;
LTRCR ; build local array CROSS REFERENCE of H.O. letter Code to Letter
+1 ;
+2 ; ! assumes a letter code can have many letter templates but one !
+3 ; ! template is of a particluar type e.g. a 30,60,90 & 120 Day H.O. !
+4 ; ! letters are all of type "B" : prescription pending expiry. !
+5 ;
+6 ; O/P : LTRX("A",Letter Code,Prosthetics Letter IEN)
+7 ; LTRX("B",Prosthetics Letter IEN)=Letter Code
+8 ;
+9 NEW LTRIEN,REC
+10 ;
+11 SET LTRIEN=0
FOR
SET LTRIEN=$ORDER(^RMPR(669.9,RMPOXITE,"RMPOLET",LTRIEN))
if LTRIEN<1
QUIT
Begin DoDot:1
+12 SET REC=^RMPR(669.9,RMPOXITE,"RMPOLET",LTRIEN,0)
SET RMPOLTR=$PIECE(REC,U)
SET RMPOLCD=$PIECE(REC,U,2)
+13 IF RMPOLCD'=""
IF (RMPOLTR'="")
SET LTRX("A",RMPOLCD,RMPOLTR)=""
SET LTRX("B",RMPOLTR)=RMPOLCD
End DoDot:1
+14 QUIT
+15 ;
GENLST ; generate patient letter list
+1 NEW REC,ADT,IADT
+2 ;
+3 SET Z=""
+4 FOR
SET Z=$ORDER(^RMPR(665,"AHO",Z))
if Z=""
QUIT
Begin DoDot:1
+5 SET RMPODFN=0
+6 FOR
SET RMPODFN=$ORDER(^RMPR(665,"AHO",Z,RMPODFN))
if RMPODFN=""
QUIT
Begin DoDot:2
+7 NEW TRXS
+8 ;
+9 ; ignore patient from another station
if $PIECE(^RMPR(665,RMPODFN,"RMPOA"),U,7)'=RMPOXITE
QUIT
+10 ;Get patient demographic data
+11 SET DFN=RMPODFN
KILL VADM
DO DEM^VADPT
+12 ;Do not collect patient if expired
+13 if $GET(VADM(6))
QUIT
+14 ; not a H.O. patient
SET REC=$GET(^RMPR(665,RMPODFN,"RMPOA"))
if REC=""
QUIT
+15 ; get Activation & InActivation DaTes
SET ADT=$PIECE(REC,U,2)
SET IADT=$PIECE(REC,U,3)
+16 ; quit if not an active H.O. patient
if ADT=""
QUIT
+17 ; build Xref of transactions (TRX) to letter type for this patient
DO FNDTRX
+18 ; get active prescription
SET RMPORX=$PIECE($GET(^RMPR(665,RMPODFN,"RMPOB",0)),U,3)
+19 ; check if new patient or inactivation letter required
+20 if $$NACT
QUIT
+21 ; get active patient prescription and evaluate letter requirement
+22 if '$DATA(^RMPR(665,RMPODFN,"RMPOB",0))
QUIT
+23 ; quit if no active prescription
if RMPORX<1
QUIT
+24 DO EXPR
End DoDot:2
End DoDot:1
+25 QUIT
+26 ;
GENOLST(BTYP) ; Generate work file from current patient letter list
+1 NEW LTRIEN
+2 ;
+3 SET RMPOLTR=0
FOR
SET RMPOLTR=$ORDER(^RMPR(665,"ALTR",RMPOLTR))
if RMPOLTR=""
QUIT
Begin DoDot:1
+4 SET RMPODFN=0
FOR
SET RMPODFN=$ORDER(^RMPR(665,"ALTR",RMPOLTR,RMPODFN))
if RMPODFN=""
QUIT
Begin DoDot:2
+5 ; ignore patients from another station
SET STA=$PIECE(^RMPR(665,RMPODFN,0),U,2)
if STA'=RMPO("STA")
QUIT
+6 SET REC=$GET(^RMPR(665,RMPODFN,"RMPOA"))
SET ADT=$PIECE(REC,U,2)
SET IADT=$PIECE(REC,U,3)
+7 SET RMPORX=$PIECE($GET(^RMPR(665,RMPODFN,"RMPOB",0)),U,3)
+8 SET LTRIEN=$ORDER(^RMPR(669.9,RMPOXITE,"RMPOLET","B",RMPOLTR,0))
+9 SET RMPOLCD=$PIECE(^RMPR(669.9,RMPOXITE,"RMPOLET",LTRIEN,0),U,2)
+10 DO EXTRCT(BTYP)
SET ^TMP($JOB,"RMPOLST",RMPOLCD,RMPODFN)=RMPOLTR
End DoDot:2
End DoDot:1
+11 QUIT
+12 ;
NACT() ; check if new patient letter or inactivation letter is required
+1 NEW FND,LST,DTE
+2 ;
+3 ; Quit if letter placed on list
FOR RMPOLCD="A","C"
Begin DoDot:1
+4 SET (LST,FND)=0
SET RMPOLTR=""
SET DTE=$SELECT(RMPOLCD="A":ADT,1:IADT)
+5 ; for each VALID H.O. letter of given Letter Code
FOR
SET RMPOLTR=$ORDER(LTRX("A",RMPOLCD,RMPOLTR))
if RMPOLTR=""
QUIT
Begin DoDot:2
+6 ; quit if letter printed on or after de/activation
IF $ORDER(TRXS(RMPOLCD,RMPOLTR,(DTE-1)))
SET FND=1
QUIT
+7 ; add person to list as requiring appropriate letter
DO EXTRCT(0)
SET ^TMP($JOB,"RMPOLST",RMPOLCD,RMPODFN)=RMPOLTR
SET LST=1
End DoDot:2
if FND
QUIT
if LST
QUIT
End DoDot:1
if LST
QUIT
+8 QUIT FND
+9 ;
EXPR ; check if prescription is pending expiry
+1 NEW REC,LTR,EXP
+2 ;
+3 SET RMPOLCD="B"
SET REC=^RMPR(665,RMPODFN,"RMPOB",RMPORX,0)
+4 ; quit if prescription already expired
SET RMPOEXP=$PIECE(REC,U,3)
if RMPOEXP<DT
QUIT
+5 SET X1=RMPOEXP
SET X2=DT
DO ^%DTC
SET RMPODAYS=X-1
+6 SET RMPODAYS=$ORDER(^RMPR(669.9,"ALTDY",RMPODAYS))
+7 ;no letter for this expiry pending period (zero to n days)
if RMPODAYS=""
QUIT
+8 ; ignore letters defined for other sites
if '$DATA(^RMPR(669.9,"ALTDY",RMPODAYS,RMPOXITE))
QUIT
+9 ;get FIRST letter assoc. with this expiry period
SET LTR=$ORDER(^RMPR(669.9,"ALTDY",RMPODAYS,RMPOXITE,0))
+10 ; get H.O. letter
SET RMPOLTR=$PIECE(^RMPR(669.9,RMPOXITE,"RMPOLET",LTR,0),U)
+11 ; H.O. letter for this expiry period has been sent
if $DATA(TRXS(RMPOLCD,RMPOLTR))
QUIT
+12 DO EXTRCT(0)
SET ^TMP($JOB,"RMPOLST",RMPOLCD,RMPODFN)=RMPOLTR
+13 QUIT
+14 ;
EXTRCT(BTYP) ;
+1 ;
+2 ; I/P : Build TYPe - 0=List, 1=Letter
+3 ;
+4 ; quit if already generated demographic details for a patient
+5 if $DATA(^TMP($JOB,"RMPODEMO",RMPODFN))
QUIT
+6 ;
+7 NEW INAME,INFO
+8 ;
+9 SET INAME=""
SET DFN=RMPODFN
+10 KILL VADM
DO DEM^VADPT
DO ADD^VADPT
+11 SET NAME=VADM(1)_U_RMPODFN
+12 ;
+13 ; if patient has an active prescription get date entered & expiry date else set dates = NULL
+14 IF RMPORX'=""
SET RMPOEXP=$PIECE(^RMPR(665,RMPODFN,"RMPOB",RMPORX,0),U,3)
SET RMPORXDT=$PIECE(^(0),U)
+15 IF '$TEST
SET (RMPOEXP,RMPORXDT)=""
+16 ;
+17 ; get primary item
+18 SET INAME=""
SET RMPOITEM=$ORDER(^RMPR(665,"AC","Y",RMPODFN,0))
+19 IF RMPOITEM'=""
Begin DoDot:1
+20 SET RMPOITEM=$PIECE(^RMPR(665,RMPODFN,"RMPOC",RMPOITEM,0),U)
SET RMPOITEM=$PIECE(^RMPR(661,RMPOITEM,0),U)
+21 SET INAME=$PIECE(^PRC(441,RMPOITEM,0),U,2)
End DoDot:1
+22 ;
+23 ;set the ^TMP($J,"RMPODEMO" global with patient demographics
+24 SET INFO=VADM(1)_U_$PIECE(VADM(2),U,2)_U_ADT_U_RMPOEXP_U_INAME
+25 if BTYP=1
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)
+26 SET ^TMP($JOB,"RMPODEMO",RMPODFN)=INFO
+27 QUIT
FNDTRX ; find letter TRX & hold in local array
+1 ;
+2 ; I/P : NONE
+3 ; O/P : TRXS(H.O. Letter Code,Prosthetics Letter,Transaction Printed Date)
+4 ;
+5 NEW TRX
+6 ;
+7 SET TRX=0
FOR
SET TRX=$ORDER(^RMPR(665.4,"B",RMPODFN,TRX))
if TRX=""
QUIT
Begin DoDot:1
+8 +9 ; ignore letters from a different station
if $PIECE(^RMPR(665.4,TRX,0),U,6)'=RMPO("STA")
QUIT
+10 ; ignore if not a H.O. letter transaction
SET RMPOLTR=$PIECE(^RMPR(665.4,TRX,0),U,2)
if '$DATA(LTRX("B",RMPOLTR))
QUIT
+11 ; get H.O. Letter Code given H.O. Letter #
SET RMPOLCD=LTRX("B",RMPOLTR)
+12 ; create local array
SET TRXS(RMPOLCD,RMPOLTR,$PIECE(^RMPR(665.4,TRX,0),U,3))=""
End DoDot:1
+13 QUIT
+14 ;
PURGE ; Purge current patient letter list
+1 SET RMPOLTR=0
FOR
SET RMPOLTR=$ORDER(^RMPR(665,"ALTR",RMPOLTR))
if RMPOLTR=""
QUIT
Begin DoDot:1
+2 SET RMPODFN=0
FOR
SET RMPODFN=$ORDER(^RMPR(665,"ALTR",RMPOLTR,RMPODFN))
if RMPODFN=""
QUIT
DO UPDLTR(RMPODFN,"@")
End DoDot:1
+3 QUIT
+4 ;
LOCK(TXT) ;
+1 ; lock virtual list record
+2 LOCK +^TMP("RMPO","LETTERPRINT"):0
IF '$TEST
WRITE !,"Cannot "_TXT_" list as list edit or printing is in progress"
QUIT 0
+3 QUIT 1
+4 ;
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 SET DR="19.13///"_VAL
SET DIE="^RMPR(665,"
DO ^DIE
+6 QUIT
+7 ;
EXIT GOTO EXIT^RMPOLETA
+1
