RAORD3.m

RAORD3 ;HISC/CAH - AISC/RMO-Detailed Request Display Cont. ; 06 Oct 2013  11:04 AM

 ;;5.0;Radiology/Nuclear Medicine;**5,15,21,27,45,41,75,99,1005**;Mar 16, 1998;Build 13

 ;Supported IA #2056 reference to ^DIQ

 ;Supported IA #10103 reference to ^XLFDT

 ;

 ;IHS/BJI/DAY - Patch 1005 - Gender Fix

 ;I $$PTSEX^RAUTL8(RADFN)="F" D  ;display pregnancy status for females ptch 45, P#99 changed Pregnancy title.'Pregnancy Screen:' field. This field shall be a display-only field

 I $$PTSEX^RAUTL8(RADFN)'="M" D

 .;

 .W !,"Pregnant at time of order entry: ",?22,$S($P(RAORD0,"^",13)="y":"YES",$P(RAORD0,"^",13)="n":"NO",1:"UNKNOWN")

 .N RA700332,RA700380

 .S RA700332=$$GET1^DIQ(70.03,$G(RACNI)_","_$G(RADTI)_","_$G(RADFN),32)

 .S RA700380=$$GET1^DIQ(70.03,$G(RACNI)_","_$G(RADTI)_","_$G(RADFN),80)

 .I RA700332'="" W !,"Pregnancy Screen: ",RA700332

 .I RA700380'="" W !,"Pregnancy Screen Comment: ",RA700380

 W:$P(RAORD0,"^",24)="y" !?12,"*** Universal Isolation Precautions ***" W:$D(RA("VDT")) !?8,$C(7),"** Note:  Request Associated with Visit on ",RA("VDT")," **"

 W:$D(RA("RDT"))&($D(RAPKG)) !,"Desired Date:",?22,RA("RDT") W:$D(RA("PDT")) !,"Pre-op Scheduled:",?22,RA("PDT") S RAOSTS=$P(RAORD0,"^",5) I RAOSTS=8,$D(RA("SDT")) W !,"Exam Scheduled:",?22,RA("SDT")

 I RAOSTS=1 D USERCAN

 W !,"Transport:",?22,RA("TRAN")

 I $L(RA("STY_REA")) D DIWP^RAUTL5(1,68,"Reason for Study: "_RA("STY_REA")) ;P75

 D ODX^RABWUTL(RAOIFN) ;display Ordering DX and Clin Inds, Billing Aware

 I $O(^RAO(75.1,RAOIFN,"H",0)) D  Q:$G(OREND)=1!($G(RAX)="^")

 . D CHIST(RAOIFN)

 . Q

 I RAOSTS=1!(RAOSTS=3) W !,"Reason ",$S(RAOSTS=1:"Cancelled",1:"Held"),":",?22,$S($D(^RA(75.2,+$P(RAORD0,"^",10),0)):$E($P(^(0),"^"),1,50),$P(RAORD0,"^",27)]"":$E($P(RAORD0,"^",27),1,50),1:"UNKNOWN") D TEXT:RAOSTS=3

 W:$D(RA("ST")) !,"Exam Status:",?22,RA("ST") W:$D(RA("ILC")) !,"Request Submitted to: ",RA("ILC")

 G A:$P(RAORD0,"^",11)'="y",A:'$D(RADTI)!('$D(RACNI))

 W !!?7,$C(7),"** Note:  Request has been changed by the Imaging Service **"

A I $D(^RAO(75.1,RAOIFN,"T")) D ASK:$E(IOST,1,2)="C-" I $D(DIRUT) S RAX="^" K DIRUT

 Q:Y'=1  I $D(RAPKG),RAX'="^" R !!,"Press return to continue or ""^"" to escape ",X:DTIME S RAX=$E(X)

 Q

 ;

ASK W ! S DIR(0)="Y",DIR("B")="NO",DIR("A")="Do you wish to display request status tracking log",DIR("?")="Enter 'YES' if status tracking log should be displayed, or 'NO' if not." D ^DIR K DIR S:$D(DIRUT) OREND=1 Q:$D(DIRUT)!(Y=0)

 W !!?20,"*** Request Status Tracking Log ***",!,"Date/Time",?18,"Status",?31,"User",?44,"Reason",!,"-----------------",?18,"------------",?31,"-----------",?44,"------------------------------------"

 F RALNB=0:0 S RALNB=$O(^RAO(75.1,RAOIFN,"T",RALNB)) Q:'RALNB  I $D(^(RALNB,0)) S RATORD0=^(0) D PRTLOG

Q K RALNB,RATORD0,RATODT,RATOST,RATREA,RATUSR Q

 ;

PRTLOG S (X,RATODT)=$P(RATORD0,"^") I X S RATODT=$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3) I $P(X,".",2) D TIME^RAUTL1 S RATODT=RATODT_" "_X

 S RATOST=$P($P(^DD(75.12,2,0),$P(RATORD0,"^",2)_":",2),";"),RATUSR=$S($D(^VA(200,+$P(RATORD0,"^",3),0)):$P(^(0),"^"),1:"")

 S RATREA=$S($D(^RA(75.2,+$P(RATORD0,"^",4),0)):$P(^(0),"^"),1:"")

 W !,RATODT,?18,$E(RATOST,1,12),?31,$E(RATUSR,1,11),?44,$E(RATREA,1,35) I $E(RATREA,36,70)'="" W !,?44,$E(RATREA,36,70)

 Q

TEXT ; display Hold Description text

 Q:'$O(^RAO(75.1,RAOIFN,1,0))

 W !,"Hold Description:",!

 K ^UTILITY($J,"W"),^(1) S DIWL=22,DIWR=75,DIWF="W"

 F RARR=0:0 S RARR=$O(^RAO(75.1,RAOIFN,1,RARR)) Q:RARR'>0  S X=^(RARR,0) D ^DIWP

 D ^DIWW

 Q

CHIST(RAY) ; display Clinical History (if applicable)

 Q:RAY'?1N.N  Q:'$O(^RAO(75.1,RAY,"H",0))

 N DIWF,DIWL,DIWR,RABAN,RARR,RAXIT

 K ^UTILITY($J,"W") S DIWL=22,DIWR=75,DIWF="",RARR=0

 F  S RARR=$O(^RAO(75.1,RAY,"H",RARR)) Q:RARR'>0  D

 . ; store into ^UTILITY($J,"W")

 . S X=$G(^RAO(75.1,RAY,"H",RARR,0)) D ^DIWP

 . Q

 S (RARR,RAXIT)=0,RABAN="Clinical History: "

 I $Y>(IOSL-4) D

 . S RAXIT=$$EOS()

 . I 'RAXIT,('$D(RAPKG)) W @IOF

 . I 'RAXIT,($D(RAPKG)) D HDR^RAORD2

 . Q

 I RAXIT S:$D(RAPKG) RAX="^" K ^UTILITY($J,"W") Q

 W !,RABAN

 F  S RARR=$O(^UTILITY($J,"W",DIWL,RARR)) Q:RARR'>0  D  Q:RAXIT

 . S X=$G(^UTILITY($J,"W",DIWL,RARR,0)) W ?22,X,!

 . I $Y>(IOSL-4) D

 .. S RAXIT=$$EOS()

 .. I 'RAXIT,('$D(RAPKG)) W @IOF

 .. I 'RAXIT,($D(RAPKG)) D HDR^RAORD2 W !

 .. Q

 . Q

 S:RAXIT&($D(RAPKG)) RAX="^" K ^UTILITY($J,"W") ; kill global

 Q

EOS() ; End of screen check for both OE/RR & Rad/Nuc Med

 ; Var List: $D(RAPKG) entry through Rad/Nuc Med, else through OE/RR

 ; Passes back 'Y', Y=1 do not continue, Y=0 continue

 ; NOTE: Sets OREND if code entered through OE/RR.  This code may be

 ;       hit when the user accesses the 'Act On Existing Orders' through

 ;       OE/RR.  'Detailed Order Display' (8^RAORR) hits ENDIS^RAORD2

 ;       which mimics (hits same code) the Rad/Nuc Med 'Detailed Request

 ;       Display' option.  The old PGBRK^ORUHDR code set OREND to 0

 ;       initially, (even though it is set to 0 upon entering this

 ;       sub-routine) and re-set it to 1 if the user enters an '^' at

 ;       the "Enter RETURN to continue or '^' to exit:" prompt.

 S Y=$$EOS^RAUTL5() S:'$D(RAPKG) OREND=Y

 Q Y

USERCAN ;user who cancelled this request

 Q:$P($G(^RAO(75.1,RAOIFN,0)),U,5)'=1  ;only look at 'discontinued'

 N RA8,RA9 S RA8=0

 F  S RA8=$O(^RAO(75.1,RAOIFN,"T",RA8)) Q:'RA8  I $G(^(RA8,0))]"",$P(^(0),U,2)=1 S RA9=RA8 ; find latest ien of 'discontinued'

 S RA("ODT")="",RA("USR")=""

 I $G(RA9) D USERCAN1

 E  D USERCAN2

 W !,"Cancelled:",?22,RA("ODT") W:RA("USR")]"" "  by ",RA("USR")

 K RA("ODT"),RA("USR")

 Q

USERCAN1 ;use request track times to get when and who cancelled

 S X=$P(^RAO(75.1,RAOIFN,"T",RA9,0),U) D:X TRDT

 S RA("USR")=$P($G(^VA(200,+$P(^RAO(75.1,RAOIFN,"T",RA9,0),U,3),0)),U)

 Q

USERCAN2 ;use vars DUZ and RAORD0 to get "who" and "when" cancelled

 S X=$P($G(RAORD0),U,18) D:X TRDT

 ; don't use  duz  if within any one of 3 rad request options

 Q:$D(RASCREEN)  Q:$D(RAOPT("ORDERPRINTS"))  Q:$D(RAOPT("ORDERPRINTPAT"))

 S RA("USR")=$P($G(^VA(200,$G(DUZ),0)),U)

 Q

TRDT S:$P(X,".",2) X=$P(X,".")_"."_$$NOSECNDS($P(X,".",2))

 S RA("ODT")=$$FMTE^XLFDT(X,"1P")

 Q

NOSECNDS(X) ; If a timestamp is associated with a date, strip off seconds.

 ; Input : X-timestamp (153048)

 ; Output: (1530)

 Q $E(X,1,4)

RAORD3    ;HISC/CAH - AISC/RMO-Detailed Request Display Cont. ; 06 Oct 2013  11:04 AM

 +1       ;;5.0;Radiology/Nuclear Medicine;**5,15,21,27,45,41,75,99,1005**;Mar 16, 1998;Build 13

 +2       ;Supported IA #2056 reference to ^DIQ

 +3       ;Supported IA #10103 reference to ^XLFDT

 +4       ;

 +5       ;IHS/BJI/DAY - Patch 1005 - Gender Fix

 +6       ;I $$PTSEX^RAUTL8(RADFN)="F" D  ;display pregnancy status for females ptch 45, P#99 changed Pregnancy title.'Pregnancy Screen:' field. This field shall be a display-only field

 +7        IF $$PTSEX^RAUTL8(RADFN)'="M"

               Begin DoDot:1

 +8       ;

 +9                WRITE !,"Pregnant at time of order entry: ",?22,$SELECT($PIECE(RAORD0,"^",13)="y":"YES",$PIECE(RAORD0,"^",13)="n":"NO",1:"UNKNOWN")

 +10               NEW RA700332,RA700380

 +11               SET RA700332=$$GET1^DIQ(70.03,$GET(RACNI)_","_$GET(RADTI)_","_$GET(RADFN),32)

 +12               SET RA700380=$$GET1^DIQ(70.03,$GET(RACNI)_","_$GET(RADTI)_","_$GET(RADFN),80)

 +13               IF RA700332'=""

                       WRITE !,"Pregnancy Screen: ",RA700332

 +14               IF RA700380'=""

                       WRITE !,"Pregnancy Screen Comment: ",RA700380

               End DoDot:1

 +15       IF $PIECE(RAORD0,"^",24)="y"

               WRITE !?12,"*** Universal Isolation Precautions ***"

           IF $DATA(RA("VDT"))

               WRITE !?8,$CHAR(7),"** Note:  Request Associated with Visit on ",RA("VDT")," **"

 +16       IF $DATA(RA("RDT"))&($DATA(RAPKG))

               WRITE !,"Desired Date:",?22,RA("RDT")

           IF $DATA(RA("PDT"))

               WRITE !,"Pre-op Scheduled:",?22,RA("PDT")

           SET RAOSTS=$PIECE(RAORD0,"^",5)

           IF RAOSTS=8

               IF $DATA(RA("SDT"))

                   WRITE !,"Exam Scheduled:",?22,RA("SDT")

 +17       IF RAOSTS=1

               DO USERCAN

 +18       WRITE !,"Transport:",?22,RA("TRAN")

 +19      ;P75

           IF $LENGTH(RA("STY_REA"))

               DO DIWP^RAUTL5(1,68,"Reason for Study: "_RA("STY_REA"))

 +20      ;display Ordering DX and Clin Inds, Billing Aware

           DO ODX^RABWUTL(RAOIFN)

 +21       IF $ORDER(^RAO(75.1,RAOIFN,"H",0))

               Begin DoDot:1

 +22               DO CHIST(RAOIFN)

 +23               QUIT 

               End DoDot:1

               IF $GET(OREND)=1!($GET(RAX)="^")

                   QUIT 

 +24       IF RAOSTS=1!(RAOSTS=3)

               WRITE !,"Reason ",$SELECT(RAOSTS=1:"Cancelled",1:"Held"),":",?22,$SELECT($DATA(^RA(75.2,+$PIECE(RAORD0,"^",10),0)):$EXTRACT($PIECE(^(0),"^"),1,50),$PIECE(RAORD0,"^",27)]"":$EXTRACT($PIECE(RAORD0,"^",27),1,50),1:"UNKNOWN")

               IF RAOSTS=3

                   DO TEXT

 +25       IF $DATA(RA("ST"))

               WRITE !,"Exam Status:",?22,RA("ST")

           IF $DATA(RA("ILC"))

               WRITE !,"Request Submitted to: ",RA("ILC")

 +26       IF $PIECE(RAORD0,"^",11)'="y"

               GOTO A

           IF '$DATA(RADTI)!('$DATA(RACNI))

               GOTO A

 +27       WRITE !!?7,$CHAR(7),"** Note:  Request has been changed by the Imaging Service **"

A          IF $DATA(^RAO(75.1,RAOIFN,"T"))

               IF $EXTRACT(IOST,1,2)="C-"

                   DO ASK

               IF $DATA(DIRUT)

                   SET RAX="^"

                   KILL DIRUT

 +1        IF Y'=1

               QUIT 

           IF $DATA(RAPKG)

               IF RAX'="^"

                   READ !!,"Press return to continue or ""^"" to escape ",X:DTIME

                   SET RAX=$EXTRACT(X)

 +2        QUIT 

 +3       ;

ASK        WRITE !

           SET DIR(0)="Y"

           SET DIR("B")="NO"

           SET DIR("A")="Do you wish to display request status tracking log"

           SET DIR("?")="Enter 'YES' if status tracking log should be displayed, or 'NO' if not."

           DO ^DIR

           KILL DIR

           IF $DATA(DIRUT)

               SET OREND=1

           IF $DATA(DIRUT)!(Y=0)

               QUIT 

 +1        WRITE !!?20,"*** Request Status Tracking Log ***",!,"Date/Time",?18,"Status",?31,"User",?44,"Reason",!,"-----------------",?18,"------------",?31,"-----------",?44,"------------------------------------"

 +2        FOR RALNB=0:0

               SET RALNB=$ORDER(^RAO(75.1,RAOIFN,"T",RALNB))

               IF 'RALNB

                   QUIT 

               IF $DATA(^(RALNB,0))

                   SET RATORD0=^(0)

                   DO PRTLOG

Q          KILL RALNB,RATORD0,RATODT,RATOST,RATREA,RATUSR

           QUIT 

 +1       ;

PRTLOG     SET (X,RATODT)=$PIECE(RATORD0,"^")

           IF X

               SET RATODT=$EXTRACT(X,4,5)_"/"_$EXTRACT(X,6,7)_"/"_$EXTRACT(X,2,3)

               IF $PIECE(X,".",2)

                   DO TIME^RAUTL1

                   SET RATODT=RATODT_" "_X

 +1        SET RATOST=$PIECE($PIECE(^DD(75.12,2,0),$PIECE(RATORD0,"^",2)_":",2),";")

           SET RATUSR=$SELECT($DATA(^VA(200,+$PIECE(RATORD0,"^",3),0)):$PIECE(^(0),"^"),1:"")

 +2        SET RATREA=$SELECT($DATA(^RA(75.2,+$PIECE(RATORD0,"^",4),0)):$PIECE(^(0),"^"),1:"")

 +3        WRITE !,RATODT,?18,$EXTRACT(RATOST,1,12),?31,$EXTRACT(RATUSR,1,11),?44,$EXTRACT(RATREA,1,35)

           IF $EXTRACT(RATREA,36,70)'=""

               WRITE !,?44,$EXTRACT(RATREA,36,70)

 +4        QUIT 

TEXT      ; display Hold Description text

 +1        IF '$ORDER(^RAO(75.1,RAOIFN,1,0))

               QUIT 

 +2        WRITE !,"Hold Description:",!

 +3        KILL ^UTILITY($JOB,"W"),^(1)

           SET DIWL=22

           SET DIWR=75

           SET DIWF="W"

 +4        FOR RARR=0:0

               SET RARR=$ORDER(^RAO(75.1,RAOIFN,1,RARR))

               IF RARR'>0

                   QUIT 

               SET X=^(RARR,0)

               DO ^DIWP

 +5        DO ^DIWW

 +6        QUIT 

CHIST(RAY) ; display Clinical History (if applicable)

 +1        IF RAY'?1N.N

               QUIT 

           IF '$ORDER(^RAO(75.1,RAY,"H",0))

               QUIT 

 +2        NEW DIWF,DIWL,DIWR,RABAN,RARR,RAXIT

 +3        KILL ^UTILITY($JOB,"W")

           SET DIWL=22

           SET DIWR=75

           SET DIWF=""

           SET RARR=0

 +4        FOR 

               SET RARR=$ORDER(^RAO(75.1,RAY,"H",RARR))

               IF RARR'>0

                   QUIT 

               Begin DoDot:1

 +5       ; store into ^UTILITY($J,"W")

 +6                SET X=$GET(^RAO(75.1,RAY,"H",RARR,0))

                   DO ^DIWP

 +7                QUIT 

               End DoDot:1

 +8        SET (RARR,RAXIT)=0

           SET RABAN="Clinical History: "

 +9        IF $Y>(IOSL-4)

               Begin DoDot:1

 +10               SET RAXIT=$$EOS()

 +11               IF 'RAXIT

                       IF ('$DATA(RAPKG))

                           WRITE @IOF

 +12               IF 'RAXIT

                       IF ($DATA(RAPKG))

                           DO HDR^RAORD2

 +13               QUIT 

               End DoDot:1

 +14       IF RAXIT

               IF $DATA(RAPKG)

                   SET RAX="^"

               KILL ^UTILITY($JOB,"W")

               QUIT 

 +15       WRITE !,RABAN

 +16       FOR 

               SET RARR=$ORDER(^UTILITY($JOB,"W",DIWL,RARR))

               IF RARR'>0

                   QUIT 

               Begin DoDot:1

 +17               SET X=$GET(^UTILITY($JOB,"W",DIWL,RARR,0))

                   WRITE ?22,X,!

 +18               IF $Y>(IOSL-4)

                       Begin DoDot:2

 +19                       SET RAXIT=$$EOS()

 +20                       IF 'RAXIT

                               IF ('$DATA(RAPKG))

                                   WRITE @IOF

 +21                       IF 'RAXIT

                               IF ($DATA(RAPKG))

                                   DO HDR^RAORD2

                                   WRITE !

 +22                       QUIT 

                       End DoDot:2

 +23               QUIT 

               End DoDot:1

               IF RAXIT

                   QUIT 

 +24      ; kill global

           IF RAXIT&($DATA(RAPKG))

               SET RAX="^"

           KILL ^UTILITY($JOB,"W")

 +25       QUIT 

EOS()     ; End of screen check for both OE/RR & Rad/Nuc Med

 +1       ; Var List: $D(RAPKG) entry through Rad/Nuc Med, else through OE/RR

 +2       ; Passes back 'Y', Y=1 do not continue, Y=0 continue

 +3       ; NOTE: Sets OREND if code entered through OE/RR.  This code may be

 +4       ;       hit when the user accesses the 'Act On Existing Orders' through

 +5       ;       OE/RR.  'Detailed Order Display' (8^RAORR) hits ENDIS^RAORD2

 +6       ;       which mimics (hits same code) the Rad/Nuc Med 'Detailed Request

 +7       ;       Display' option.  The old PGBRK^ORUHDR code set OREND to 0

 +8       ;       initially, (even though it is set to 0 upon entering this

 +9       ;       sub-routine) and re-set it to 1 if the user enters an '^' at

 +10      ;       the "Enter RETURN to continue or '^' to exit:" prompt.

 +11       SET Y=$$EOS^RAUTL5()

           IF '$DATA(RAPKG)

               SET OREND=Y

 +12       QUIT Y

USERCAN   ;user who cancelled this request

 +1       ;only look at 'discontinued'

           IF $PIECE($GET(^RAO(75.1,RAOIFN,0)),U,5)'=1

               QUIT 

 +2        NEW RA8,RA9

           SET RA8=0

 +3       ; find latest ien of 'discontinued'

           FOR 

               SET RA8=$ORDER(^RAO(75.1,RAOIFN,"T",RA8))

               IF 'RA8

                   QUIT 

               IF $GET(^(RA8,0))]""

                   IF $PIECE(^(0),U,2)=1

                       SET RA9=RA8

 +4        SET RA("ODT")=""

           SET RA("USR")=""

 +5        IF $GET(RA9)

               DO USERCAN1

 +6       IF '$TEST

               DO USERCAN2

 +7        WRITE !,"Cancelled:",?22,RA("ODT")

           IF RA("USR")]""

               WRITE "  by ",RA("USR")

 +8        KILL RA("ODT"),RA("USR")

 +9        QUIT 

USERCAN1  ;use request track times to get when and who cancelled

 +1        SET X=$PIECE(^RAO(75.1,RAOIFN,"T",RA9,0),U)

           IF X

               DO TRDT

 +2        SET RA("USR")=$PIECE($GET(^VA(200,+$PIECE(^RAO(75.1,RAOIFN,"T",RA9,0),U,3),0)),U)

 +3        QUIT 

USERCAN2  ;use vars DUZ and RAORD0 to get "who" and "when" cancelled

 +1        SET X=$PIECE($GET(RAORD0),U,18)

           IF X

               DO TRDT

 +2       ; don't use  duz  if within any one of 3 rad request options

 +3        IF $DATA(RASCREEN)

               QUIT 

           IF $DATA(RAOPT("ORDERPRINTS"))

               QUIT 

           IF $DATA(RAOPT("ORDERPRINTPAT"))

               QUIT 

 +4        SET RA("USR")=$PIECE($GET(^VA(200,$GET(DUZ),0)),U)

 +5        QUIT 

TRDT       IF $PIECE(X,".",2)

               SET X=$PIECE(X,".")_"."_$$NOSECNDS($PIECE(X,".",2))

 +1        SET RA("ODT")=$$FMTE^XLFDT(X,"1P")

 +2        QUIT 

NOSECNDS(X) ; If a timestamp is associated with a date, strip off seconds.

 +1       ; Input : X-timestamp (153048)

 +2       ; Output: (1530)

 +3        QUIT $EXTRACT(X,1,4)