Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RAORD4

RAORD4.m

Go to the documentation of this file.
  1. 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
  1. ;Call RAPSET1 to establish RAMDV
  1. D SET^RAPSET1 I $D(XQUIT) K XQUIT Q
  1. K RALOC I $P(RAMDV,"^",21) D ASKLOC G Q:'$D(RALOC)
  1. W !!,"Request Status Selection",!,"------------------------" S RARD("A")="Select Status: "
  1. S RARD(1)="Discontinued^print discontinued requests.",RARD(2)="Complete^print completed requests.",RARD(3)="Hold^print requests on hold."
  1. S RARD(4)="Pending^print pending requests.",RARD(5)="Request Active^print active requests.",RARD(6)="Scheduled^print scheduled requests."
  1. S RARD(7)="All Current Orders^print hold, pending, active and scheduled requests.",RARD("B")=4
  1. 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=""
  1. ;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
  1. W !!!,"Date Criteria Selection",!,"-----------------------"
  1. ;p216/KLM - Update date selection to include Scheduled Date
  1. 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
  1. S RASKTIME="" S RADDT=1 D DATE1^RAUTL K RADDT,RASKTIME G Q:RAPOP
  1. D HS G Q:$D(DIRUT)
  1. S ZTRTN="START^RAORD4",ZTSAVE("BEGDATE")="",ZTSAVE("ENDDATE")="",ZTSAVE("RAOASTS")="",ZTSAVE("RAHS")="",ZTSAVE("RACRIT")="" S:$D(RALOC) ZTSAVE("RALOC")=""
  1. S:$D(RAOPT) ZTSAVE("RAOPT(")=""
  1. W ! D ZIS^RAUTL G:RAPOP Q
  1. ;
  1. START ; Start printing process
  1. U IO K ^TMP($J,"RAHS"),^TMP($J,"RAORD4")
  1. S RABEGDT=$S($P(BEGDATE,".",2):BEGDATE,1:BEGDATE-.0001),RAENDDT=$S($P(ENDDATE,".",2):ENDDATE,1:ENDDATE+.9999)
  1. 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
  1. I '$D(^TMP($J,"RAORD4")) D G Q
  1. . W:$Y>0 @IOF
  1. . W !?5,"There are no Requests for the selected Date Range."
  1. . Q
  1. 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
  1. ;
  1. 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
  1. K ^TMP($J,"RAHS"),^TMP($J,"RAORD4")
  1. K RAMES,X,X1,Y,J,Z,ZTDESC,ZTRTN,ZTSAVE
  1. W ! D CLOSE^RAUTL
  1. D Q^RAORD5
  1. K C,DFN,DIC,DIR,DISYS,DIW,DIWT,D0,POP
  1. Q
  1. ;
  1. ;;The following code is used to SET-UP the utility global
  1. 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)
  1. Q
  1. ;
  1. 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
  1. Q
  1. ;
  1. SETUTL S ^TMP($J,"RAORD4",$S($D(RALNM):RALNM,1:"L"),$S($P(RAORD0,"^",6):$P(RAORD0,"^",6),1:9),RAOSTS,RAODTE,RAOIFN)=RAORD0
  1. Q
  1. ;
  1. 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
  1. S DIC="^RA(79.1,",DIC(0)="EMQ" D ^DIC I Y>0 S RALOC=+Y Q
  1. W:X'["?" *7 W !!?3,"Enter 'ALL' or select an Imaging Location to print pending requests." G ASKLOC
  1. ;
  1. ;;The following code is used to PRINT the utility global
  1. CHKSTA F RAOSTS=0:0 S RAOSTS=$O(^TMP($J,"RAORD4",RALNM,RAOURG,RAOSTS)) Q:'RAOSTS!(RAX["^") D CHKDTE
  1. Q
  1. ;
  1. CHKDTE F RAODTE=0:0 S RAODTE=$O(^TMP($J,"RAORD4",RALNM,RAOURG,RAOSTS,RAODTE)) Q:'RAODTE!(RAX["^") D CHKUTL
  1. Q
  1. ;
  1. CHKUTL ; Print Health Summary if applicable
  1. N RA751 S RAOIFN=0
  1. F S RAOIFN=$O(^TMP($J,"RAORD4",RALNM,RAOURG,RAOSTS,RAODTE,RAOIFN)) Q:'RAOIFN!(RAX["^") D
  1. . S RADFN=+$G(^TMP($J,"RAORD4",RALNM,RAOURG,RAOSTS,RAODTE,RAOIFN))
  1. . S RA751(0)=$G(^RAO(75.1,RAOIFN,0)),RA751(2)=$P(RA751(0),"^",2)
  1. . D ^RAORD5 Q:RAHS=0!(RAX["^")
  1. . S GMTSTYP=+$P($G(^RAMIS(71,+RA751(2),0)),"^",13)
  1. . Q:GMTSTYP'>0!($D(^TMP($J,"RAHS",GMTSTYP,RADFN)))
  1. . I $E(IOST)="C" D CRCHK^RAORD6 Q:RAX["^"
  1. . K DIROUT W:$Y>0 @IOF D ENX^GMTSDVR(RADFN,GMTSTYP)
  1. . S RAPGE=0,^TMP($J,"RAHS",GMTSTYP,RADFN)=""
  1. . S:$D(DIROUT) RAX="^"
  1. . Q
  1. Q
  1. HS ; print Health Summary for each patient?
  1. W ! K DIR,DIRUT,DIROUT,DTOUT,DUOUT
  1. S DIR(0)="Y",DIR("A")="Print HEALTH SUMMARY for each patient"
  1. D ^DIR K DIR
  1. Q:$D(DIRUT)
  1. S RAHS=+Y
  1. Q