- RAORD4 ;HISC/CAH,FPT,GJC AISC/RMO - Print Requests by Date ; May 23, 2024@14:14:53
- ;;5.0;Radiology/Nuclear Medicine;**216**;Mar 16, 1998;Build 2
- ;Call RAPSET1 to establish RAMDV
- D SET^RAPSET1 I $D(XQUIT) K XQUIT Q
- K RALOC I $P(RAMDV,"^",21) D ASKLOC G Q:'$D(RALOC)
- W !!,"Request Status Selection",!,"------------------------" S RARD("A")="Select Status: "
- S RARD(1)="Discontinued^print discontinued requests.",RARD(2)="Complete^print completed requests.",RARD(3)="Hold^print requests on hold."
- S RARD(4)="Pending^print pending requests.",RARD(5)="Request Active^print active requests.",RARD(6)="Scheduled^print scheduled requests."
- S RARD(7)="All Current Orders^print hold, pending, active and scheduled requests.",RARD("B")=4
- D SET^RARD K RARD G Q:X["^" S RAOASTS=$S($E(X)="D":"1",$E(X)="C":"2",$E(X)="H":"3",$E(X)="P":"5",$E(X)="R":"6",$E(X)="S":"8",$E(X)="A":"3;5;6;8",1:"") G Q:RAOASTS=""
- ;Based on whether user wants requests included based on Date Entered (fld 16) or Date Desired (fld 21), set RACRIT to correct piece # of Rad Order rec
- W !!!,"Date Criteria Selection",!,"-----------------------"
- ;p216/KLM - Update date selection to include Scheduled Date
- K DIR S DIR(0)="S^E:ENTRY DATE OF REQUEST;D:DESIRED DATE FOR EXAM;S:SCHEDULED DATE OF EXAM",DIR("A")="Date criteria to use for choosing requests to print",DIR("B")="E" D ^DIR G Q:$D(DTOUT)!($D(DUOUT)) S RACRIT=$S(Y="D":21,Y="S":23,1:16) ;ch
- S RASKTIME="" S RADDT=1 D DATE1^RAUTL K RADDT,RASKTIME G Q:RAPOP
- D HS G Q:$D(DIRUT)
- S ZTRTN="START^RAORD4",ZTSAVE("BEGDATE")="",ZTSAVE("ENDDATE")="",ZTSAVE("RAOASTS")="",ZTSAVE("RAHS")="",ZTSAVE("RACRIT")="" S:$D(RALOC) ZTSAVE("RALOC")=""
- S:$D(RAOPT) ZTSAVE("RAOPT(")=""
- W ! D ZIS^RAUTL G:RAPOP Q
- ;
- START ; Start printing process
- U IO K ^TMP($J,"RAHS"),^TMP($J,"RAORD4")
- S RABEGDT=$S($P(BEGDATE,".",2):BEGDATE,1:BEGDATE-.0001),RAENDDT=$S($P(ENDDATE,".",2):ENDDATE,1:ENDDATE+.9999)
- F RADFN=0:0 S RADFN=$O(^RAO(75.1,"AS",RADFN)) Q:'RADFN F RALP=1:1 S RAOSTS=$P(RAOASTS,";",RALP) Q:RAOSTS="" D CHKORD
- I '$D(^TMP($J,"RAORD4")) D G Q
- . W:$Y>0 @IOF
- . W !?5,"There are no Requests for the selected Date Range."
- . Q
- S (RALNM,RAX)="",RAPGE=0 F RAILP=0:0 S RALNM=$O(^TMP($J,"RAORD4",RALNM)) Q:RALNM=""!(RAX["^") F RAOURG=0:0 S RAOURG=$O(^TMP($J,"RAORD4",RALNM,RAOURG)) Q:'RAOURG!(RAX["^") D CHKSTA
- ;
- Q K BEGDATE,D,DN,DIROUT,DIRUT,DTOUT,DUOUT,ENDDATE,GMTSTYP,POP,RAPOP,RABEGDT,RACRIT,RADFN,RADTI,RACNI,RAENDDT,RAHS,RALIFN,RALNM,RALOC,RALP,RAOASTS,RAODTE,RAOIFN,RAOURG,RAPGE,RAX,DIC,RAILP,RAORD0,RAOSTS,VAERR,VAIN
- K ^TMP($J,"RAHS"),^TMP($J,"RAORD4")
- K RAMES,X,X1,Y,J,Z,ZTDESC,ZTRTN,ZTSAVE
- W ! D CLOSE^RAUTL
- D Q^RAORD5
- K C,DFN,DIC,DIR,DISYS,DIW,DIWT,D0,POP
- Q
- ;
- ;;The following code is used to SET-UP the utility global
- CHKORD F RAOIFN=0:0 S RAOIFN=$O(^RAO(75.1,"AS",RADFN,RAOSTS,RAOIFN)) Q:'RAOIFN I $D(^RAO(75.1,RAOIFN,0)) S RAORD0=^(0),RAODTE=+$P(RAORD0,"^",RACRIT) I RAODTE>RABEGDT,RAODTE<RAENDDT D CHKLOC:$D(RALOC),SETUTL:'$D(RALOC)
- Q
- ;
- CHKLOC I RALOC="ALL"!(RALOC=+$P(RAORD0,"^",20)) S RALIFN=+$P(RAORD0,"^",20),RALNM=$S('$D(^RA(79.1,RALIFN,0)):"UNKNOWN",$D(^SC(+^(0),0)):$P(^(0),"^"),1:"UNKNOWN") D SETUTL
- Q
- ;
- SETUTL S ^TMP($J,"RAORD4",$S($D(RALNM):RALNM,1:"L"),$S($P(RAORD0,"^",6):$P(RAORD0,"^",6),1:9),RAOSTS,RAODTE,RAOIFN)=RAORD0
- Q
- ;
- ASKLOC R !!,"Select IMAGING LOCATION: ",X:DTIME Q:'$T!(X="^")!(X="") I $E(X,1,3)="ALL"!($E(X,1,3)="all") S RALOC="ALL" Q
- S DIC="^RA(79.1,",DIC(0)="EMQ" D ^DIC I Y>0 S RALOC=+Y Q
- W:X'["?" *7 W !!?3,"Enter 'ALL' or select an Imaging Location to print pending requests." G ASKLOC
- ;
- ;;The following code is used to PRINT the utility global
- CHKSTA F RAOSTS=0:0 S RAOSTS=$O(^TMP($J,"RAORD4",RALNM,RAOURG,RAOSTS)) Q:'RAOSTS!(RAX["^") D CHKDTE
- Q
- ;
- CHKDTE F RAODTE=0:0 S RAODTE=$O(^TMP($J,"RAORD4",RALNM,RAOURG,RAOSTS,RAODTE)) Q:'RAODTE!(RAX["^") D CHKUTL
- Q
- ;
- CHKUTL ; Print Health Summary if applicable
- N RA751 S RAOIFN=0
- F S RAOIFN=$O(^TMP($J,"RAORD4",RALNM,RAOURG,RAOSTS,RAODTE,RAOIFN)) Q:'RAOIFN!(RAX["^") D
- . S RADFN=+$G(^TMP($J,"RAORD4",RALNM,RAOURG,RAOSTS,RAODTE,RAOIFN))
- . S RA751(0)=$G(^RAO(75.1,RAOIFN,0)),RA751(2)=$P(RA751(0),"^",2)
- . D ^RAORD5 Q:RAHS=0!(RAX["^")
- . S GMTSTYP=+$P($G(^RAMIS(71,+RA751(2),0)),"^",13)
- . Q:GMTSTYP'>0!($D(^TMP($J,"RAHS",GMTSTYP,RADFN)))
- . I $E(IOST)="C" D CRCHK^RAORD6 Q:RAX["^"
- . K DIROUT W:$Y>0 @IOF D ENX^GMTSDVR(RADFN,GMTSTYP)
- . S RAPGE=0,^TMP($J,"RAHS",GMTSTYP,RADFN)=""
- . S:$D(DIROUT) RAX="^"
- . Q
- Q
- HS ; print Health Summary for each patient?
- W ! K DIR,DIRUT,DIROUT,DTOUT,DUOUT
- S DIR(0)="Y",DIR("A")="Print HEALTH SUMMARY for each patient"
- D ^DIR K DIR
- Q:$D(DIRUT)
- S RAHS=+Y
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAORD4 4709 printed Feb 19, 2025@00:04:23 Page 2
- RAORD4 ;HISC/CAH,FPT,GJC AISC/RMO - Print Requests by Date ; May 23, 2024@14:14:53
- +1 ;;5.0;Radiology/Nuclear Medicine;**216**;Mar 16, 1998;Build 2
- +2 ;Call RAPSET1 to establish RAMDV
- +3 DO SET^RAPSET1
- IF $DATA(XQUIT)
- KILL XQUIT
- QUIT
- +4 KILL RALOC
- IF $PIECE(RAMDV,"^",21)
- DO ASKLOC
- if '$DATA(RALOC)
- GOTO Q
- +5 WRITE !!,"Request Status Selection",!,"------------------------"
- SET RARD("A")="Select Status: "
- +6 SET RARD(1)="Discontinued^print discontinued requests."
- SET RARD(2)="Complete^print completed requests."
- SET RARD(3)="Hold^print requests on hold."
- +7 SET RARD(4)="Pending^print pending requests."
- SET RARD(5)="Request Active^print active requests."
- SET RARD(6)="Scheduled^print scheduled requests."
- +8 SET RARD(7)="All Current Orders^print hold, pending, active and scheduled requests."
- SET RARD("B")=4
- +9 DO SET^RARD
- KILL RARD
- if X["^"
- GOTO Q
- SET RAOASTS=$SELECT($EXTRACT(X)="D":"1",$EXTRACT(X)="C":"2",$EXTRACT(X)="H":"3",$EXTRACT(X)="P":"5",$EXTRACT(X)="R":"6",$EXTRACT(X)="S":"8",$EXTRACT(X)="A":"3;5;6;8",1:"")
- if RAOASTS=""
- GOTO Q
- +10 ;Based on whether user wants requests included based on Date Entered (fld 16) or Date Desired (fld 21), set RACRIT to correct piece # of Rad Order rec
- +11 WRITE !!!,"Date Criteria Selection",!,"-----------------------"
- +12 ;p216/KLM - Update date selection to include Scheduled Date
- +13 ;ch
- KILL DIR
- SET DIR(0)="S^E:ENTRY DATE OF REQUEST;D:DESIRED DATE FOR EXAM;S:SCHEDULED DATE OF EXAM"
- SET DIR("A")="Date criteria to use for choosing requests to print"
- SET DIR("B")="E"
- DO ^DIR
- if $DATA(DTOUT)!($DATA(DUOUT))
- GOTO Q
- SET RACRIT=$SELECT(Y="D":21,Y="S":23,1:16)
- +14 SET RASKTIME=""
- SET RADDT=1
- DO DATE1^RAUTL
- KILL RADDT,RASKTIME
- if RAPOP
- GOTO Q
- +15 DO HS
- if $DATA(DIRUT)
- GOTO Q
- +16 SET ZTRTN="START^RAORD4"
- SET ZTSAVE("BEGDATE")=""
- SET ZTSAVE("ENDDATE")=""
- SET ZTSAVE("RAOASTS")=""
- SET ZTSAVE("RAHS")=""
- SET ZTSAVE("RACRIT")=""
- if $DATA(RALOC)
- SET ZTSAVE("RALOC")=""
- +17 if $DATA(RAOPT)
- SET ZTSAVE("RAOPT(")=""
- +18 WRITE !
- DO ZIS^RAUTL
- if RAPOP
- GOTO Q
- +19 ;
- START ; Start printing process
- +1 USE IO
- KILL ^TMP($JOB,"RAHS"),^TMP($JOB,"RAORD4")
- +2 SET RABEGDT=$SELECT($PIECE(BEGDATE,".",2):BEGDATE,1:BEGDATE-.0001)
- SET RAENDDT=$SELECT($PIECE(ENDDATE,".",2):ENDDATE,1:ENDDATE+.9999)
- +3 FOR RADFN=0:0
- SET RADFN=$ORDER(^RAO(75.1,"AS",RADFN))
- if 'RADFN
- QUIT
- FOR RALP=1:1
- SET RAOSTS=$PIECE(RAOASTS,";",RALP)
- if RAOSTS=""
- QUIT
- DO CHKORD
- +4 IF '$DATA(^TMP($JOB,"RAORD4"))
- Begin DoDot:1
- +5 if $Y>0
- WRITE @IOF
- +6 WRITE !?5,"There are no Requests for the selected Date Range."
- +7 QUIT
- End DoDot:1
- GOTO Q
- +8 SET (RALNM,RAX)=""
- SET RAPGE=0
- FOR RAILP=0:0
- SET RALNM=$ORDER(^TMP($JOB,"RAORD4",RALNM))
- if RALNM=""!(RAX["^")
- QUIT
- FOR RAOURG=0:0
- SET RAOURG=$ORDER(^TMP($JOB,"RAORD4",RALNM,RAOURG))
- if 'RAOURG!(RAX["^")
- QUIT
- DO CHKSTA
- +9 ;
- Q KILL BEGDATE,D,DN,DIROUT,DIRUT,DTOUT,DUOUT,ENDDATE,GMTSTYP,POP,RAPOP,RABEGDT,RACRIT,RADFN,RADTI,RACNI,RAENDDT,RAHS,RALIFN,RALNM,RALOC,RALP,RAOASTS,RAODTE,RAOIFN,RAOURG,RAPGE,RAX,DIC,RAILP,RAORD0,RAOSTS,VAERR,VAIN
- +1 KILL ^TMP($JOB,"RAHS"),^TMP($JOB,"RAORD4")
- +2 KILL RAMES,X,X1,Y,J,Z,ZTDESC,ZTRTN,ZTSAVE
- +3 WRITE !
- DO CLOSE^RAUTL
- +4 DO Q^RAORD5
- +5 KILL C,DFN,DIC,DIR,DISYS,DIW,DIWT,D0,POP
- +6 QUIT
- +7 ;
- +8 ;;The following code is used to SET-UP the utility global
- CHKORD FOR RAOIFN=0:0
- SET RAOIFN=$ORDER(^RAO(75.1,"AS",RADFN,RAOSTS,RAOIFN))
- if 'RAOIFN
- QUIT
- IF $DATA(^RAO(75.1,RAOIFN,0))
- SET RAORD0=^(0)
- SET RAODTE=+$PIECE(RAORD0,"^",RACRIT)
- IF RAODTE>RABEGDT
- IF RAODTE<RAENDDT
- if $DATA(RALOC)
- DO CHKLOC
- if '$DATA(RALOC)
- DO SETUTL
- +1 QUIT
- +2 ;
- CHKLOC IF RALOC="ALL"!(RALOC=+$PIECE(RAORD0,"^",20))
- SET RALIFN=+$PIECE(RAORD0,"^",20)
- SET RALNM=$SELECT('$DATA(^RA(79.1,RALIFN,0)):"UNKNOWN",$DATA(^SC(+^(0),0)):$PIECE(^(0),"^"),1:"UNKNOWN")
- DO SETUTL
- +1 QUIT
- +2 ;
- SETUTL SET ^TMP($JOB,"RAORD4",$SELECT($DATA(RALNM):RALNM,1:"L"),$SELECT($PIECE(RAORD0,"^",6):$PIECE(RAORD0,"^",6),1:9),RAOSTS,RAODTE,RAOIFN)=RAORD0
- +1 QUIT
- +2 ;
- ASKLOC READ !!,"Select IMAGING LOCATION: ",X:DTIME
- if '$TEST!(X="^")!(X="")
- QUIT
- IF $EXTRACT(X,1,3)="ALL"!($EXTRACT(X,1,3)="all")
- SET RALOC="ALL"
- QUIT
- +1 SET DIC="^RA(79.1,"
- SET DIC(0)="EMQ"
- DO ^DIC
- IF Y>0
- SET RALOC=+Y
- QUIT
- +2 if X'["?"
- WRITE *7
- WRITE !!?3,"Enter 'ALL' or select an Imaging Location to print pending requests."
- GOTO ASKLOC
- +3 ;
- +4 ;;The following code is used to PRINT the utility global
- CHKSTA FOR RAOSTS=0:0
- SET RAOSTS=$ORDER(^TMP($JOB,"RAORD4",RALNM,RAOURG,RAOSTS))
- if 'RAOSTS!(RAX["^")
- QUIT
- DO CHKDTE
- +1 QUIT
- +2 ;
- CHKDTE FOR RAODTE=0:0
- SET RAODTE=$ORDER(^TMP($JOB,"RAORD4",RALNM,RAOURG,RAOSTS,RAODTE))
- if 'RAODTE!(RAX["^")
- QUIT
- DO CHKUTL
- +1 QUIT
- +2 ;
- CHKUTL ; Print Health Summary if applicable
- +1 NEW RA751
- SET RAOIFN=0
- +2 FOR
- SET RAOIFN=$ORDER(^TMP($JOB,"RAORD4",RALNM,RAOURG,RAOSTS,RAODTE,RAOIFN))
- if 'RAOIFN!(RAX["^")
- QUIT
- Begin DoDot:1
- +3 SET RADFN=+$GET(^TMP($JOB,"RAORD4",RALNM,RAOURG,RAOSTS,RAODTE,RAOIFN))
- +4 SET RA751(0)=$GET(^RAO(75.1,RAOIFN,0))
- SET RA751(2)=$PIECE(RA751(0),"^",2)
- +5 DO ^RAORD5
- if RAHS=0!(RAX["^")
- QUIT
- +6 SET GMTSTYP=+$PIECE($GET(^RAMIS(71,+RA751(2),0)),"^",13)
- +7 if GMTSTYP'>0!($DATA(^TMP($JOB,"RAHS",GMTSTYP,RADFN)))
- QUIT
- +8 IF $EXTRACT(IOST)="C"
- DO CRCHK^RAORD6
- if RAX["^"
- QUIT
- +9 KILL DIROUT
- if $Y>0
- WRITE @IOF
- DO ENX^GMTSDVR(RADFN,GMTSTYP)
- +10 SET RAPGE=0
- SET ^TMP($JOB,"RAHS",GMTSTYP,RADFN)=""
- +11 if $DATA(DIROUT)
- SET RAX="^"
- +12 QUIT
- End DoDot:1
- +13 QUIT
- HS ; print Health Summary for each patient?
- +1 WRITE !
- KILL DIR,DIRUT,DIROUT,DTOUT,DUOUT
- +2 SET DIR(0)="Y"
- SET DIR("A")="Print HEALTH SUMMARY for each patient"
- +3 DO ^DIR
- KILL DIR
- +4 if $DATA(DIRUT)
- QUIT
- +5 SET RAHS=+Y
- +6 QUIT