RAORDR ;ABV/SCR/MKN - Refer Pending/Hold Requests ; Jul 12, 2022@09:32:46
;;5.0;Radiology/Nuclear Medicine;**148,161,170,179,190**;Mar 16, 1998;Build 1
;
; Routine/File IA Type
; -------------------------------------
; DEM^VADPT 10061 (S)
; ^DIWP 10011 (S)
; ^SC( 10040 (S)
; ^VA(200 10060 (S)
; ^DPT( 10035 (S)
; CMT^ORQQCN2 NONE
; ^OR(100 5771,6475 (C)
; ^GMR(123 6116,2586 (C)
;
Q
ENT ;Entry
;
N DIC,DIR,DIRUT,DTOUT,DUOUT,QQ,RA123IEN,RA44NA,RAANS,RAANS2,RAARAY,RAARRAY
N RACDW,RACDWN,RACIENS,RACOMCT,RACNT,RACOM,RACOUNT,RADD,RADFN,RADT,RAEND
N RAERR,RAEXPL,RAF,RAHDR,RAI,RAILOC,RAJUST,RAJUST2,RAILOC1,RALOCNM,RAMAND
N RAN,RANOW,RANOW2,RAO,RAOBEG,RAOEND,RAOIFN,RAOPHY,RAORD0,RAORDIEN,RAPOP
N RAPR,RAPRTYDT,RAQUES,RAQUIT,RAREAS,RAREQSTA,RARES,RASELOC,RASTART,RASUB
N RAT,RAUCID,X,Y,RAEXP
;
S (RAARRAY,RACIENS,RAILOC)=""
GETPAT ;
S (RACOUNT,RASELOC)=0 K RAEOS
K DIC,DIRUT,^TMP("RAORDR",$J),RAARRAY
S DIC="^DPT(",DIC(0)="AEMQ" D ^DIC K DIC
I $D(DIRUT) S RAQUIT=1
Q:$G(RAQUIT)!($G(Y)=-1)
S RADFN=+Y
K DIR S DIR(0)="E" D ^DIR G:'+Y GETPAT
S Y="P",RAQUIT=0
W !
S RACOUNT=0
F RAREQSTA=3,5,8 S RAOIFN=0 F S RAOIFN=$O(^RAO(75.1,"AS",RADFN,RAREQSTA,RAOIFN)) Q:'RAOIFN!($D(RAEOS)) D
. I $D(^RAO(75.1,RAOIFN,0)) D
. . S RAO(0)=^RAO(75.1,RAOIFN,0) I RAREQSTA=3&($P(RAO(0),U,7)) Q:$$AUTOHOLD($P(RAO(0),U,7))
. . S RAOPHY=$P(RAO(0),U,14)
. . S RALADT=$P(RAO(0),U,21)
. . S RACOUNT=RACOUNT+1,RAARRAY(RACOUNT)=RAOIFN
I '$D(RAARRAY(1)) W !,"No Imaging orders found for this patient",! G GETPAT
S (RACOUNT,RAF,RARES)=0
D GETORD
G:'RARES!(RAQUIT) GETPAT
S RAORDIEN=$$MAKECONS^RAORDR1($G(RAARRAY(Y)))
;Add comments to Consult that was just created
;P170
N I,RET
S RAUCID="",RA123IEN=$G(^OR(100,RAORDIEN,4)) I $P(RA123IEN,";",2)="GMRC" D
.S RA123IEN=+RA123IEN,RAUCID=$$GET1^DIQ(123,RA123IEN,80)
.D:RA123IEN
..S RACOM(1)="#COI#",RACOM(2)="COI-Veteran OPT-IN for Community Care",RACOM(3)=$P(RAREAS,U,2)
..I $D(RAEXP) D
...D BRKLINE(.RET,RAEXP,74)
...S I=0 F S I=$O(RET(I)) Q:I="" S RACOM(I+3)=$G(RET(I))
...Q
..S RADT=$$NOW^XLFDT() ;p179 - comment activity date is now
..L +^GMR(123,RA123IEN):5 I '$T D ERROR^RAORDR1("Consult record locked, cannot update comments.") Q ;p161 -Lock consult
..D CMT^ORQQCN2(.RAERR,RA123IEN,.RACOM,"N","",RADT)
..L -^GMR(123,RA123IEN)
.W !!,"Consult with UCID: "_$S(RAUCID]"":RAUCID,1:"(Not known)")," has been created",!
.I 'RA123IEN W !!,"**NO Consult created**",!
D KILL
G GETPAT
;
KILL ;
K DIC,DIR,DIRUT,QQ,RA123IEN,RA44NA,RAANS,RAANS2,RAARAY,RAARRAY,RACDW,RACDWN,RACIENS,RACOMCT,RACNT,RACOM
K RACOUNT,RADD,RADFN,RADT,RAEND,RAERR,RAEXPL,RAF,RAHDR,RAI,RAILOC,RAJUST,RAJUST2,RAILOC1,RALOCNM,RAN,RANOW
K RANOW2,RAO,RAOBEG,RAOEND,RAOIFN,RAOPHY,RAORD0,RAORDIEN,RAPOP,RAPR,RAPRTYDT,RAQUES,RAQUIT,RAREAS,RAUDIV
K RAREQSTA,RARES,RASELOC,RASTART,RASUB,RAT,RAUCID,X,Y,RET,RAEXP,RALADT,RAOI,ORDIALOG,RAEXP,RAIENS,RASOC
S (RACIENS,RAILOC)=""
Q
;
AUTOHOLD(ORIFN) ;
;Return:
; 0 if this consult was placed on Hold other than as a result of auto-submission following an imaging order
; 1 if this consult was placed on Hold as a result of auto-submission following an imaging order
N OR123,ORACT,ORCCFND,X
Q:'ORIFN
S (ORACT,ORCCFND)=0 F S ORACT=$O(^OR(100,ORIFN,8,ORACT)) Q:'ORACT S X=$G(^OR(100,ORIFN,8,ORACT,1)) D:X]""
.I X["Placed on hold due to transfer to Community Care with UCID" S X=$P(X,"UCID",2) D
..S X=$P(X,"_",2) I X?1.N,$D(^GMR(123,X)) S ORCCFND=1 Q
Q ORCCFND
;
HDR ; header
W:$Y>0 @IOF
W !?(80-$L(RAHDR)/2),RAHDR
W !,"PATIENT NAME",?35,"SSN",?47,"PROCEDURE"
W !,?10,"DATE DESIRED",?25,"DATE ORDERED",?55,$S(RAREQSTA=3:"HOLD DT",1:"ORDERING PROVIDER")
W !?10,"IMAGING LOCATION",?50,"REQUEST STATUS"
W !,QQ
W !
Q
GETORD ;
N DFN,RADFNARY,RALADT,RAMORE,RAQUIT,RAREA,VADM
K VADM S DFN=RADFN D DEM^VADPT
S RACOUNT=0
S QQ="",$P(QQ,"=",80)="="
SELORDER ;
S RAHDR="SELECT FROM IMAGING ORDERS"
D HDR Q:$D(RAEOS)
S (RAMORE,RAQUIT)=0 F Q:RAQUIT S RACOUNT=$O(RAARRAY(RACOUNT)) Q:'RACOUNT!(RAQUIT) S RAO=RAARRAY(RACOUNT) D
.S:RACOUNT RAT=RACOUNT S:RAF=0 RAF=RAT
.S RAORD0=^RAO(75.1,+RAO,0),RADT=$P(RAORD0,U,21),RALADT=$P(RAORD0,U,16),RAPR=$P(RAORD0,U,2),RASELOC=$P(RAORD0,U,20)
.S Y=RADT
.D DD^%DT
.S RADD=Y
.S Y=$P(RALADT,".")
.D DD^%DT
.S RAPRTYDT=Y
.W !,RACOUNT_". ",$E(VADM(1),1,31)
.W ?35,"*****",$E(VADM(2),$L(VADM(2))-3,$L(VADM(2)))
.W ?47,$S($D(^RAMIS(71,RAPR,0)):$E($P(^(0),U),1,24),1:"Unknown")
.W !,?10,RADD,?25,RAPRTYDT,?57,$E($P($G(^VA(200,RAOPHY,0)),U,1),1,23)
.W !?10,$S('RASELOC:"Unknown",$D(^RA(79.1,RASELOC,0)):$S($D(^SC($P(^(0),U),0)):$P(^(0),U),1:"Unknown"),1:"Unknown")
.W ?50,$$GET1^DIQ(75.1,+RAO_",",5,"E")
.S:$Y>20 RAQUIT=1
K DIR,DIRUT S RACIENS=""
S DIR(0)="NO^"_RAF_":"_RAT
S DIR("A")="Select NUMBER of ORDER to be REFERRED to COMMUNITY CARE"
I RAT?1.N,RACOUNT]"",$O(RAARRAY(RACOUNT))]"" S DIR("A")=DIR("A")_" or press Enter for more orders" S RAMORE=1
E S $P(DIR(0),U)="N" ;Remove "O" flag
D ^DIR
K DIR
I Y=""&(RAMORE) S RAF=0 G SELORDER
Q:Y=""&('RAMORE)
Q:$D(DIRUT)
W !,"You selected number "_Y
S RARES=Y
Q
GETINFO(RAARAY) ;this function collects information that would be collected from a SEOC in Consult Toolbox
N DIR,DIRUT,RACOUNT,RAGMRC1,RARPT,Y
;
S (RAJUST,RAQUIT,RARPT)=0
;D SETJUST2 ;Set up RAJUST array with prompts
D GETMAIN
S:'$D(RAARAY("TYPEOFSERVICE")) RAARAY("TYPEOFSERVICE")="4^Diagnostic"
S RAARAY("THIRDPARTY")="2^NO"
S RAARAY("TRAUMA")="2^NO"
Q
;
GETMAIN ;Ask the main questions and fill in the answers at tag GETJSUB
;P170 - CC Justifications now stored in file #75.3 instead of hardcoded in this routine.
N RAJN,RAJJ,RAI,CNT S RAJN=""
W !!,"Justification for Community Care"
;W !!,?5,"Select one of the following:",!
S RAI=0 F S RAI=$O(^RA(75.3,RAI)) Q:RAI="B" D
.S RAJJ=$$GET1^DIQ(75.3,RAI,.01),RAJJ=$S($L(RAJJ,":")>1:$P(RAJJ,": ",2),1:RAJJ)
.I RAI=1 S RAJN=RAI_":"_RAJJ_";"
.E S RAJN=RAJN_RAI_":"_RAJJ_";"
.Q
S RAJN=$E(RAJN,1,$L(RAJN)-1)
N DIR,Y S DIR(0)="S^"_RAJN D ^DIR I $D(DIRUT) S RAQUIT=1 Q
S RAREAS=Y_"^"_$$GET1^DIQ(75.3,Y,.01) K DIR,Y
I RAREAS="" S RAQUIT=1 Q
I $$GET1^DIQ(75.3,+RAREAS,2,"I")=1 D
.S DIR(0)="F^3:240",DIR("A")="EXPLAIN" S DIR("?")="Enter Explaination for '"_$P(RAREAS,U,2)_"': 3-240 characters"
.D ^DIR I $D(DIRUT) S RAQUIT=1 Q
.S RAEXP=Y
.Q
K DIR,DIRUT,Y
Q
BRKLINE(OUT,LINE,LGTH) ;Break line down into 80 character lines in OUT
N CT,DIWL,DIWR,I,X
S LINE=$$TRIM^XLFSTR(LINE)
K ^UTILITY($J,"W") S CT=0,DIWL=1,DIWR=LGTH,X=LINE D ^DIWP
S I="" F S I=$O(^UTILITY($J,"W",1,I)) Q:'I S CT=CT+1,OUT(CT)=^UTILITY($J,"W",1,I,0)
K ^UTILITY($J,"W")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAORDR 6911 printed Jan 19, 2023@22:07:51 Page 2
RAORDR ;ABV/SCR/MKN - Refer Pending/Hold Requests ; Jul 12, 2022@09:32:46
+1 ;;5.0;Radiology/Nuclear Medicine;**148,161,170,179,190**;Mar 16, 1998;Build 1
+2 ;
+3 ; Routine/File IA Type
+4 ; -------------------------------------
+5 ; DEM^VADPT 10061 (S)
+6 ; ^DIWP 10011 (S)
+7 ; ^SC( 10040 (S)
+8 ; ^VA(200 10060 (S)
+9 ; ^DPT( 10035 (S)
+10 ; CMT^ORQQCN2 NONE
+11 ; ^OR(100 5771,6475 (C)
+12 ; ^GMR(123 6116,2586 (C)
+13 ;
+14 QUIT
ENT ;Entry
+1 ;
+2 NEW DIC,DIR,DIRUT,DTOUT,DUOUT,QQ,RA123IEN,RA44NA,RAANS,RAANS2,RAARAY,RAARRAY
+3 NEW RACDW,RACDWN,RACIENS,RACOMCT,RACNT,RACOM,RACOUNT,RADD,RADFN,RADT,RAEND
+4 NEW RAERR,RAEXPL,RAF,RAHDR,RAI,RAILOC,RAJUST,RAJUST2,RAILOC1,RALOCNM,RAMAND
+5 NEW RAN,RANOW,RANOW2,RAO,RAOBEG,RAOEND,RAOIFN,RAOPHY,RAORD0,RAORDIEN,RAPOP
+6 NEW RAPR,RAPRTYDT,RAQUES,RAQUIT,RAREAS,RAREQSTA,RARES,RASELOC,RASTART,RASUB
+7 NEW RAT,RAUCID,X,Y,RAEXP
+8 ;
+9 SET (RAARRAY,RACIENS,RAILOC)=""
GETPAT ;
+1 SET (RACOUNT,RASELOC)=0
KILL RAEOS
+2 KILL DIC,DIRUT,^TMP("RAORDR",$JOB),RAARRAY
+3 SET DIC="^DPT("
SET DIC(0)="AEMQ"
DO ^DIC
KILL DIC
+4 IF $DATA(DIRUT)
SET RAQUIT=1
+5 if $GET(RAQUIT)!($GET(Y)=-1)
QUIT
+6 SET RADFN=+Y
+7 KILL DIR
SET DIR(0)="E"
DO ^DIR
if '+Y
GOTO GETPAT
+8 SET Y="P"
SET RAQUIT=0
+9 WRITE !
+10 SET RACOUNT=0
+11 FOR RAREQSTA=3,5,8
SET RAOIFN=0
FOR
SET RAOIFN=$ORDER(^RAO(75.1,"AS",RADFN,RAREQSTA,RAOIFN))
if 'RAOIFN!($DATA(RAEOS))
QUIT
Begin DoDot:1
+12 IF $DATA(^RAO(75.1,RAOIFN,0))
Begin DoDot:2
+13 SET RAO(0)=^RAO(75.1,RAOIFN,0)
IF RAREQSTA=3&($PIECE(RAO(0),U,7))
if $$AUTOHOLD($PIECE(RAO(0),U,7))
QUIT
+14 SET RAOPHY=$PIECE(RAO(0),U,14)
+15 SET RALADT=$PIECE(RAO(0),U,21)
+16 SET RACOUNT=RACOUNT+1
SET RAARRAY(RACOUNT)=RAOIFN
End DoDot:2
End DoDot:1
+17 IF '$DATA(RAARRAY(1))
WRITE !,"No Imaging orders found for this patient",!
GOTO GETPAT
+18 SET (RACOUNT,RAF,RARES)=0
+19 DO GETORD
+20 if 'RARES!(RAQUIT)
GOTO GETPAT
+21 SET RAORDIEN=$$MAKECONS^RAORDR1($GET(RAARRAY(Y)))
+22 ;Add comments to Consult that was just created
+23 ;P170
+24 NEW I,RET
+25 SET RAUCID=""
SET RA123IEN=$GET(^OR(100,RAORDIEN,4))
IF $PIECE(RA123IEN,";",2)="GMRC"
Begin DoDot:1
+26 SET RA123IEN=+RA123IEN
SET RAUCID=$$GET1^DIQ(123,RA123IEN,80)
+27 if RA123IEN
Begin DoDot:2
+28 SET RACOM(1)="#COI#"
SET RACOM(2)="COI-Veteran OPT-IN for Community Care"
SET RACOM(3)=$PIECE(RAREAS,U,2)
+29 IF $DATA(RAEXP)
Begin DoDot:3
+30 DO BRKLINE(.RET,RAEXP,74)
+31 SET I=0
FOR
SET I=$ORDER(RET(I))
if I=""
QUIT
SET RACOM(I+3)=$GET(RET(I))
+32 QUIT
End DoDot:3
+33 ;p179 - comment activity date is now
SET RADT=$$NOW^XLFDT()
+34 ;p161 -Lock consult
LOCK +^GMR(123,RA123IEN):5
IF '$TEST
DO ERROR^RAORDR1("Consult record locked, cannot update comments.")
QUIT
+35 DO CMT^ORQQCN2(.RAERR,RA123IEN,.RACOM,"N","",RADT)
+36 LOCK -^GMR(123,RA123IEN)
End DoDot:2
+37 WRITE !!,"Consult with UCID: "_$SELECT(RAUCID]"":RAUCID,1:"(Not known)")," has been created",!
+38 IF 'RA123IEN
WRITE !!,"**NO Consult created**",!
End DoDot:1
+39 DO KILL
+40 GOTO GETPAT
+41 ;
KILL ;
+1 KILL DIC,DIR,DIRUT,QQ,RA123IEN,RA44NA,RAANS,RAANS2,RAARAY,RAARRAY,RACDW,RACDWN,RACIENS,RACOMCT,RACNT,RACOM
+2 KILL RACOUNT,RADD,RADFN,RADT,RAEND,RAERR,RAEXPL,RAF,RAHDR,RAI,RAILOC,RAJUST,RAJUST2,RAILOC1,RALOCNM,RAN,RANOW
+3 KILL RANOW2,RAO,RAOBEG,RAOEND,RAOIFN,RAOPHY,RAORD0,RAORDIEN,RAPOP,RAPR,RAPRTYDT,RAQUES,RAQUIT,RAREAS,RAUDIV
+4 KILL RAREQSTA,RARES,RASELOC,RASTART,RASUB,RAT,RAUCID,X,Y,RET,RAEXP,RALADT,RAOI,ORDIALOG,RAEXP,RAIENS,RASOC
+5 SET (RACIENS,RAILOC)=""
+6 QUIT
+7 ;
AUTOHOLD(ORIFN) ;
+1 ;Return:
+2 ; 0 if this consult was placed on Hold other than as a result of auto-submission following an imaging order
+3 ; 1 if this consult was placed on Hold as a result of auto-submission following an imaging order
+4 NEW OR123,ORACT,ORCCFND,X
+5 if 'ORIFN
QUIT
+6 SET (ORACT,ORCCFND)=0
FOR
SET ORACT=$ORDER(^OR(100,ORIFN,8,ORACT))
if 'ORACT
QUIT
SET X=$GET(^OR(100,ORIFN,8,ORACT,1))
if X]""
Begin DoDot:1
+7 IF X["Placed on hold due to transfer to Community Care with UCID"
SET X=$PIECE(X,"UCID",2)
Begin DoDot:2
+8 SET X=$PIECE(X,"_",2)
IF X?1.N
IF $DATA(^GMR(123,X))
SET ORCCFND=1
QUIT
End DoDot:2
End DoDot:1
+9 QUIT ORCCFND
+10 ;
HDR ; header
+1 if $Y>0
WRITE @IOF
+2 WRITE !?(80-$LENGTH(RAHDR)/2),RAHDR
+3 WRITE !,"PATIENT NAME",?35,"SSN",?47,"PROCEDURE"
+4 WRITE !,?10,"DATE DESIRED",?25,"DATE ORDERED",?55,$SELECT(RAREQSTA=3:"HOLD DT",1:"ORDERING PROVIDER")
+5 WRITE !?10,"IMAGING LOCATION",?50,"REQUEST STATUS"
+6 WRITE !,QQ
+7 WRITE !
+8 QUIT
GETORD ;
+1 NEW DFN,RADFNARY,RALADT,RAMORE,RAQUIT,RAREA,VADM
+2 KILL VADM
SET DFN=RADFN
DO DEM^VADPT
+3 SET RACOUNT=0
+4 SET QQ=""
SET $PIECE(QQ,"=",80)="="
SELORDER ;
+1 SET RAHDR="SELECT FROM IMAGING ORDERS"
+2 DO HDR
if $DATA(RAEOS)
QUIT
+3 SET (RAMORE,RAQUIT)=0
FOR
if RAQUIT
QUIT
SET RACOUNT=$ORDER(RAARRAY(RACOUNT))
if 'RACOUNT!(RAQUIT)
QUIT
SET RAO=RAARRAY(RACOUNT)
Begin DoDot:1
+4 if RACOUNT
SET RAT=RACOUNT
if RAF=0
SET RAF=RAT
+5 SET RAORD0=^RAO(75.1,+RAO,0)
SET RADT=$PIECE(RAORD0,U,21)
SET RALADT=$PIECE(RAORD0,U,16)
SET RAPR=$PIECE(RAORD0,U,2)
SET RASELOC=$PIECE(RAORD0,U,20)
+6 SET Y=RADT
+7 DO DD^%DT
+8 SET RADD=Y
+9 SET Y=$PIECE(RALADT,".")
+10 DO DD^%DT
+11 SET RAPRTYDT=Y
+12 WRITE !,RACOUNT_". ",$EXTRACT(VADM(1),1,31)
+13 WRITE ?35,"*****",$EXTRACT(VADM(2),$LENGTH(VADM(2))-3,$LENGTH(VADM(2)))
+14 WRITE ?47,$SELECT($DATA(^RAMIS(71,RAPR,0)):$EXTRACT($PIECE(^(0),U),1,24),1:"Unknown")
+15 WRITE !,?10,RADD,?25,RAPRTYDT,?57,$EXTRACT($PIECE($GET(^VA(200,RAOPHY,0)),U,1),1,23)
+16 WRITE !?10,$SELECT('RASELOC:"Unknown",$DATA(^RA(79.1,RASELOC,0)):$SELECT($DATA(^SC($PIECE(^(0),U),0)):$PIECE(^(0),U),1:"Unknown"),1:"Unknown")
+17 WRITE ?50,$$GET1^DIQ(75.1,+RAO_",",5,"E")
+18 if $Y>20
SET RAQUIT=1
End DoDot:1
+19 KILL DIR,DIRUT
SET RACIENS=""
+20 SET DIR(0)="NO^"_RAF_":"_RAT
+21 SET DIR("A")="Select NUMBER of ORDER to be REFERRED to COMMUNITY CARE"
+22 IF RAT?1.N
IF RACOUNT]""
IF $ORDER(RAARRAY(RACOUNT))]""
SET DIR("A")=DIR("A")_" or press Enter for more orders"
SET RAMORE=1
+23 ;Remove "O" flag
IF '$TEST
SET $PIECE(DIR(0),U)="N"
+24 DO ^DIR
+25 KILL DIR
+26 IF Y=""&(RAMORE)
SET RAF=0
GOTO SELORDER
+27 if Y=""&('RAMORE)
QUIT
+28 if $DATA(DIRUT)
QUIT
+29 WRITE !,"You selected number "_Y
+30 SET RARES=Y
+31 QUIT
GETINFO(RAARAY) ;this function collects information that would be collected from a SEOC in Consult Toolbox
+1 NEW DIR,DIRUT,RACOUNT,RAGMRC1,RARPT,Y
+2 ;
+3 SET (RAJUST,RAQUIT,RARPT)=0
+4 ;D SETJUST2 ;Set up RAJUST array with prompts
+5 DO GETMAIN
+6 if '$DATA(RAARAY("TYPEOFSERVICE"))
SET RAARAY("TYPEOFSERVICE")="4^Diagnostic"
+7 SET RAARAY("THIRDPARTY")="2^NO"
+8 SET RAARAY("TRAUMA")="2^NO"
+9 QUIT
+10 ;
GETMAIN ;Ask the main questions and fill in the answers at tag GETJSUB
+1 ;P170 - CC Justifications now stored in file #75.3 instead of hardcoded in this routine.
+2 NEW RAJN,RAJJ,RAI,CNT
SET RAJN=""
+3 WRITE !!,"Justification for Community Care"
+4 ;W !!,?5,"Select one of the following:",!
+5 SET RAI=0
FOR
SET RAI=$ORDER(^RA(75.3,RAI))
if RAI="B"
QUIT
Begin DoDot:1
+6 SET RAJJ=$$GET1^DIQ(75.3,RAI,.01)
SET RAJJ=$SELECT($LENGTH(RAJJ,":")>1:$PIECE(RAJJ,": ",2),1:RAJJ)
+7 IF RAI=1
SET RAJN=RAI_":"_RAJJ_";"
+8 IF '$TEST
SET RAJN=RAJN_RAI_":"_RAJJ_";"
+9 QUIT
End DoDot:1
+10 SET RAJN=$EXTRACT(RAJN,1,$LENGTH(RAJN)-1)
+11 NEW DIR,Y
SET DIR(0)="S^"_RAJN
DO ^DIR
IF $DATA(DIRUT)
SET RAQUIT=1
QUIT
+12 SET RAREAS=Y_"^"_$$GET1^DIQ(75.3,Y,.01)
KILL DIR,Y
+13 IF RAREAS=""
SET RAQUIT=1
QUIT
+14 IF $$GET1^DIQ(75.3,+RAREAS,2,"I")=1
Begin DoDot:1
+15 SET DIR(0)="F^3:240"
SET DIR("A")="EXPLAIN"
SET DIR("?")="Enter Explaination for '"_$PIECE(RAREAS,U,2)_"': 3-240 characters"
+16 DO ^DIR
IF $DATA(DIRUT)
SET RAQUIT=1
QUIT
+17 SET RAEXP=Y
+18 QUIT
End DoDot:1
+19 KILL DIR,DIRUT,Y
+20 QUIT
BRKLINE(OUT,LINE,LGTH) ;Break line down into 80 character lines in OUT
+1 NEW CT,DIWL,DIWR,I,X
+2 SET LINE=$$TRIM^XLFSTR(LINE)
+3 KILL ^UTILITY($JOB,"W")
SET CT=0
SET DIWL=1
SET DIWR=LGTH
SET X=LINE
DO ^DIWP
+4 SET I=""
FOR
SET I=$ORDER(^UTILITY($JOB,"W",1,I))
if 'I
QUIT
SET CT=CT+1
SET OUT(CT)=^UTILITY($JOB,"W",1,I,0)
+5 KILL ^UTILITY($JOB,"W")
+6 QUIT
