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

RAMAORPT.m

Go to the documentation of this file. 
  1. RAMAORPT ;HISC/GJC Report on the studies overridden to 'Complete' P160 ; Aug 25, 2020@09:22:36
  1.  ;;5.0;Radiology/Nuclear Medicine;**160**;Mar 16, 1998;Build 4
  1.  ;
  1.  ;Routine/File            IA          Type
  1.  ;----------------------------------------
  1.  ;^SC(                    10040        (S) 
  1.  ;^DIC(4,                 10090        (S)
  1.  ;^%ZIS(1,                10114        (S)
  1.  ;^DPT(                   10035        (S)
  1.  ;$$PATCH^XPDUTL()        10141        (S)
  1.  ;$$NAME^XUAF4             2171        (S)
  1.  ;$$KSP^XUPARAM            2541        (S)
  1.  ;$$EN^XUTMDEVQ            1519        (S)
  1.  ;$$FMTE^XLFDT            10103        (S)
  1.  ;WAIT^DICD               10007        (S)
  1.  ;
  1.  ;key cross-reference used in this software:
  1.  ;-------------------------------------------
  1.  ;^RADPT("ATO",1,3100525.0835,391,2,1)=""
  1.  ;  2nd sub: overridden by RA5P160? - 3rd sub: RADTE
  1.  ;  4th sub: RADFN (inv. date/time) - 5th sub: RACNI
  1.  ;
  1. EN ;entry point
  1.  I $$PATCH^XPDUTL("RA*5.0*160")'=1 D  Q
  1.  .W !!,"No override data available; Radiology patch RA*5.0*160 has not been installed.",!
  1.  .Q
  1.  ;
  1.  I ($D(^RADPT("ATO",1))\10)=0 D  Q
  1.  .W !!?3,"There are no radiology studies overridden to 'complete'.",!
  1.  .Q
  1.  ;
  1.  N RABEGIN S RABEGIN=$$BEGIN() Q:RABEGIN=-1
  1.  S RABEGIN(0)=$P(RABEGIN,U,2) ;ext begin d/t format
  1.  ;
  1.  N RAEND S RAEND=$$END(+RABEGIN) Q:RAEND=-1
  1.  S RAEND(0)=$P(RAEND,U,2) ;ext end d/t format
  1.  ;
  1.  W ! D WAIT^DICD
  1.  ;
  1. ENRPT ;report tag, not callable
  1.  ;
  1.  K ^TMP("RA P160",$J) N CNT S CNT=0
  1.  S RAC=9999999.9999,RAR=$NA(^RADPT("ATO",1)),RADTE=+RABEGIN
  1.  F  S RADTE=$O(@RAR@(RADTE)) Q:RADTE'>0!(RADTE>+RAEND)  D
  1.  .S RADFN=0
  1.  .F  S RADFN=$O(@RAR@(RADTE,RADFN)) Q:RADFN'>0  D
  1.  ..S RADTI=RAC-RADTE
  1.  ..S RAY2=$G(^RADPT(RADFN,"DT",RADTI,0)) Q:RAY2=""
  1.  ..K RARY D GETS^DIQ(2,RADFN,".01;.0905","E","RARY")
  1.  ..S RAPAT=$G(RARY(2,RADFN_",",.01,"E")) ;"LIME,HARRY LAWRENCE"
  1.  ..S:RAPAT="" RAPAT=RADFN_"*"
  1.  ..S RAPID=$G(RARY(2,RADFN_",",.0905,"E")) ;"L0000"
  1.  ..S:RAPID="" RAPID="n/a"
  1.  ..K RARY
  1.  ..;
  1.  ..;get accession
  1.  ..S RACNI=0
  1.  ..F  S RACNI=$O(@RAR@(RADTE,RADFN,RACNI)) Q:RACNI'>0  D
  1.  ...S RAY3=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)) Q:RAY3=""
  1.  ...S RACCNUM=$E(RAY2,4,7)_$E(RAY2,2,3)_"-"_+RAY3 ;legacy
  1.  ...;
  1.  ...S CNT=CNT+1 W:(CNT#1500)=0 "." ;print a period to the screen
  1.  ...;the periodic printing of a period indicates process life
  1.  ...S ^TMP("RA P160",$J,RADTE,RAPAT,RAPID,RACCNUM)=RADFN_U_RADTI_U_RACNI
  1.  ...;
  1.  ...Q
  1.  ..Q
  1.  .Q
  1.  ;
  1.  ;now print the report to a device!
  1.  S RALAST=$$LAST()
  1.  I RALAST=-1 W !!,"There is no data to be printed!",! D EXIT QUIT
  1.  ;
  1.  S ZTSAVE("^TMP(""RA P160"",$J)")="",ZTSAVE("RALAST")=""
  1.  S RADESC="RA STUDIES OVERRIDDEN TO COMPLETE"
  1.  ;select a spool device or the screen
  1.  S %ZIS("S")="I $$DEVSCR^RAMAORPT(+Y)"
  1.  D EN^XUTMDEVQ("OUTPUT^RAMAORPT",RADESC,.ZTSAVE,.%ZIS,1)
  1.  I $D(ZTSK)#2 W !!,"This report has been tasked with task number: ",ZTSK
  1.  K %ZIS,RAC,RACCNUM,RACNI,RADESC,RADFN,RADTE,RADTI,RAPAT,RAPID,RAR
  1.  K RASSAN,RASSN,RAY2,RAY3,X,Y,ZTSAVE,ZTSK
  1.  Q
  1.  ;
  1. OUTPUT ;output the data
  1.  S (RACNT,RAPG,RAXIT)=0 S $P(RALINE,"-",81)=""
  1.  S RAFAC=$$NAME^XUAF4(+$$KSP^XUPARAM("INST"))
  1.  S RATITLE="VistA Radiology report to identify studies overridden to 'Complete'"
  1.  S RADATE=$$FMTE^XLFDT($$DT^XLFDT,1) D HDR
  1.  ;
  1.  ;we have data: ^TMP("RA P160",$J,RADTE,RAPAT,RAPID,RACCNUM)=RADFN_U_RADTI_U_RACNI
  1.  S RADTE=0,RATMP=$NA(^TMP("RA P160",$J))
  1.  F  S RADTE=$O(@RATMP@(RADTE)) Q:RADTE'>0  D  Q:RAXIT
  1.  .S RAPAT="" F  S RAPAT=$O(@RATMP@(RADTE,RAPAT)) Q:RAPAT=""  D  Q:RAXIT
  1.  ..S RAPID="" F  S RAPID=$O(@RATMP@(RADTE,RAPAT,RAPID)) Q:RAPID=""  D  Q:RAXIT
  1.  ...S RACCNUM=""
  1.  ...F  S RACCNUM=$O(@RATMP@(RADTE,RAPAT,RAPID,RACCNUM)) Q:RACCNUM=""  D  Q:RAXIT
  1.  ....S RAX=$G(@RATMP@(RADTE,RAPAT,RAPID,RACCNUM)),RADFN=$P(RAX,U)
  1.  ....S RADTI=$P(RAX,U,2),RACNI=$P(RAX,U,3),RAY2=$G(^RADPT(RADFN,"DT",RADTI,0))
  1.  ....S RAEXAMDT=$$FMTE^XLFDT(+RAY2,"2P")
  1.  ....S RAY3=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)) ;ray2 & ray3 should never be null
  1.  ....S RAPROC=$E($P($G(^RAMIS(71,+$P(RAY3,U,2),0)),U),1,40)
  1.  ....S RAOIFN=+$P(RAY3,U,11),RAOSTS="NO ORDER"
  1.  ....S RARPT=+$P(RAY3,U,17),RARPTSTS="NO REPORT"
  1.  ....;
  1.  ....I RAOIFN D  ;get request (order) status
  1.  .....NEW RA751 D GETS^DIQ(75.1,RAOIFN,5,"E","RA751")
  1.  .....S RAOSTS=$G(RA751(75.1,RAOIFN_",",5,"E"))
  1.  .....S:RAOSTS="" RAOSTS="NULL"
  1.  .....Q
  1.  ....;
  1.  ....I RARPT D  ;get report status
  1.  .....NEW RA74 D GETS^DIQ(74,RARPT,5,"E","RA74")
  1.  .....S RARPTSTS=$E($G(RA74(74,RARPT_",",5,"E")),1,18)
  1.  .....S:RARPTSTS="" RARPTSTS="NULL"
  1.  .....Q
  1.  ....;
  1.  ....W !,RAPAT,?33,RAPID,?40,RAEXAMDT,?59,RACCNUM
  1.  ....W !?2,RAPROC,?44,RAOSTS,?62,RARPTSTS,!
  1.  ....I $Y>(IOSL-4) D  Q:RAXIT
  1.  .....Q:$$QEOS()=1  ;we've displayed the last of the data quit
  1.  .....;more data... if to screen issue end of page prompt to user
  1.  .....S:$E(IOST)="C" RAXIT=$$PAUSE()
  1.  .....Q:RAXIT  D HDR ;if user exits quit else display header
  1.  .....Q
  1.  ....S RACNT=RACNT+1
  1.  ....I RACNT#500=0 S (RAXIT,ZTSTOP)=$$S^%ZTLOAD() Q:RAXIT
  1.  ...Q
  1.  ..Q
  1.  .Q
  1.  D EXQUE
  1.  Q
  1.  ;
  1. LAST() ;find the last collated ^TMP("RA P160",$J)
  1.  ; to decide report formatting (new page?)
  1.  ; Ex: ^TMP("RA P160",$J,2980731.1925,"HHUYLYIHM,CRLY C",
  1.  ;          "H0956","073198-7716")=""
  1.  ;-------------------------------------------
  1.  ;output: X array concatenating RADTE, NAME,
  1.  ;        1U4N & accession into a string 
  1.  ;        (delimiter = caret)
  1.  ;--------------------------------------------
  1.  Q:($D(^TMP("RA P160",$J))\10)=0 -1
  1.  N RAR,PP,QQ,RR,VV
  1.  S RAR=$NA(^TMP("RA P160",$J))
  1.  S PP=$O(@RAR@($C(32)),-1)
  1.  S QQ=$O(@RAR@(PP,$C(127)),-1)
  1.  S RR=$O(@RAR@(PP,QQ,$C(127)),-1)
  1.  S VV=$O(@RAR@(PP,QQ,RR,$C(127)),-1)
  1.  Q PP_U_QQ_U_RR_U_VV ;sets RALAST
  1.  ;
  1. QEOS() ;check if the EOS should be called. if Q=1 we're
  1.  ; on the last record; (don't refresh/call header)
  1.  ;---------------------------------------------------
  1.  ; input: RADTE, RADFN, RACNI & RALAST exist (global)
  1.  ;output: '0' if more records to search
  1.  ;        '1' if on last record
  1.  ;---------------------------------------------------
  1.  ;
  1.  N Q S Q=0
  1.  I RADTE=$P(RALAST,U),RAPAT=$P(RALAST,U,2),RAPID=$P(RALAST,U,3),RACCNUM=$P(RALAST,U,4) S Q=1
  1.  QUIT Q
  1.  ;
  1. PAUSE() ;pause if send to screen
  1.  ;returns: zero to continue, one to quit
  1.  N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
  1.  S DIR(0)="E" D ^DIR
  1.  Q $S(Y'>0:1,1:0)
  1.  ;
  1. BEGIN() ;Prompt the user for the study registration starting date
  1.  ;RADATE-Today's date; DT-implicitly defined as today's date(internal format)
  1.  ;RAEARLY-Earliest conceivable starting date
  1.  W ! K DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
  1.  N RA1,RA2,RARSLT S RA1=2110101,RA2=3081231
  1.  S DIR(0)="DA^"_RA1_":"_RA2_":PEX"
  1.  S DIR("A",1)="Enter the start date to begin searching for those studies"
  1.  S DIR("A")="overridden to 'Complete': "
  1.  S DIR("?",1)="This is the date from which our search will begin. The starting"
  1.  S DIR("?",2)="date must not fall after: "_$$FMTE^XLFDT(RA2,"1D")_".",DIR("?",3)=""
  1.  S DIR("?")="Dates associated with a time will not be accepted."
  1.  S DIR("B")=$$FMTE^XLFDT(RA1,"1D") D ^DIR
  1.  S:$D(DIRUT) RARSLT=-1 S:'$D(DIRUT) RARSLT=Y_U_Y(0)
  1.  K DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
  1.  Q RARSLT
  1.  ;
  1. END(RAX) ;Prompt the user for the ending date report verified (no greater than a 
  1.  ;year after the start date input by the user)
  1.  ; DT - implicitly defined as today's date(internal format)
  1.  ;RAX - The search start date (internal format^external format )
  1.  ;
  1.  W ! K DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
  1.  N RA1,RA1X,RA2,RA2X,RARSLT
  1.  S RA1=$P(RAX,U),RA2=3081231,RA2X=$$FMTE^XLFDT(RA2,"1D")
  1.  S RA1X=$$FMTE^XLFDT(RA1,"1D")
  1.  S DIR(0)="DA^"_RA1_":"_RA2_":PEX"
  1.  S DIR("A")="Enter an end date of: "
  1.  S DIR("?",1)="This is the date in which our search will end. The ending date"
  1.  S DIR("?",2)="must not precede: "_RA1X_" and must not exceed: "_RA2X_"."
  1.  S DIR("?",3)="",DIR("?")="Dates associated with a time will not be accepted."
  1.  S DIR("B")=RA2X D ^DIR K DIR
  1.  S:$D(DIRUT) RARSLT=-1 S:'$D(DIRUT) RARSLT=(Y+0.9999)_U_Y(0)
  1.  K DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
  1.  Q RARSLT
  1.  ;
  1. HDR ;header for reports
  1.  I RAPG!($E(IOST,1,2)="C-") W @IOF
  1.  S RAPG=RAPG+1 W !?(IOM-$L(RATITLE)\2),RATITLE
  1.  W !,"Run Date: ",RADATE,?67,"Page: ",RAPG
  1.  W !,"Facility: ",RAFAC
  1.  W !!,"Patient",?33,"Pat ID",?40,"Exam Date/Time",?59,"Accession #"
  1.  W !?2,"Procedure",?44,"Request Status",?62,"Report Status"
  1.  W !,RALINE
  1.  Q
  1.  ;
  1. EXQUE ;if queued set ZTREQ
  1.  S:$D(ZTQUEUED) ZTREQ="@"
  1. EXIT ;kill task in task log, clean up symbol table.
  1.  K RACCNUM,RACNI,RACNT,RADATE,RADFN,RADTE,RADTI,RAEXAMDT,RAFAC,RAILOC,RALAST
  1.  K RALINE,RAOIFN,RAOSTS,RAPAT,RAPG,RAPID,RAPROC,RARPT,RATITLE,RATMP,RARPTSTS
  1.  K RAX,RAXIT,RAY2,RAY3,X,Y
  1.  K ^TMP("RA P160",$J)
  1.  Q
  1.  ;
  1. DEVSCR(Y) ;device screen (either spool or home)
  1.  ; input: Y = IEN of DEVICE record (#3.5) numeric
  1.  ;return: $T either 0 or 1
  1.  ;
  1.  N RASTYP,RATYP,RAX
  1.  D GETS^DIQ(3.5,Y,"2:3","E","RAX")
  1.  S RATYP=$G(RAX(3.5,Y_",",2,"E")) ;TYPE
  1.  S RASTYP=$E($G(RAX(3.5,Y_",",3,"E")),1,2) ;SUBTYPE
  1.  Q $S((RATYP="SPOOL"!(RASTYP="C-")):1,1:0)
  1.  ;