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

RACMHIS.m

Go to the documentation of this file. 
  1. RACMHIS ;HISC/GJC-Radiology Contrast Media History option (driver)
  1.  ;;5.0;Radiology/Nuclear Medicine;**45**;Mar 16, 1998
  1.  ;Note: new routine with the release of RA*5*45
  1.  ;
  1. EN ;begin; find all procedures with a CM audit history
  1.  S RADIC="^RAMIS(71,",RADIC(0)="EMQZ",RADIC("A")="Select Procedure: "
  1.  S RADIC("S")="I $O(^RAMIS(71,+Y,""AUD"",0))",RAUTIL="RA PROC W/CM"
  1.  K ^TMP($J,"RA PROC W/CM") D EN1^RASELCT(.RADIC,RAUTIL,"",1)
  1.  I $O(^TMP($J,"RA PROC W/CM",""))="" D  D KILL Q
  1.  .W !?3,"No procedures have been selected, exiting this option." Q
  1.  ;
  1. STRTDT ;Prompt for Starting Date
  1.  W ! K DIR S DIR(0)="DA^:"_DT_":PEA"
  1.  S DIR("A")="Enter the start date for the search: "
  1.  S DIR("?",1)="This is the date from which our search will begin."
  1.  S DIR("?",2)="Think of it in terms of 'FROM' and 'TO'. This date is our 'FROM'."
  1.  S DIR("?",3)="The starting date must not exceed: "_$$FMTE^XLFDT(DT,"1P")_"."
  1.  S DIR("?")="Dates associated with a time will not be accepted."
  1.  D ^DIR K DIR
  1.  I $D(DIRUT) D KILL Q
  1.  ;int. date/time ^ ext. date/time ^ int. date/time minus one second
  1.  S RASTRT=Y_"^"_Y(0)_"^"_$$FMADD^XLFDT(Y,"","","",-1)
  1.  ;
  1. ENDDT ;Prompt for Ending Date
  1.  W ! K DIR S DIR(0)="DA^"_$P(RASTRT,U)_":"_DT_":PEA"
  1.  S DIR("A")="Enter the ending date for the search: "
  1.  S DIR("?",1)="This is the date in which our search will end."
  1.  S DIR("?",2)="Think of it in terms of 'FROM' and 'TO'. This date is our 'TO'."
  1.  S DIR("?",3)="The ending date must not exceed: "_$$FMTE^XLFDT(DT,"1P")_"."
  1.  S DIR("?",4)="The ending date must not precede: "_$P(RASTRT,U,2)_"."
  1.  S DIR("?")="Dates associated with a time will not be accepted."
  1.  D ^DIR K DIR
  1.  I $D(DIRUT) D KILL Q
  1.  ;int. date/time ^ ext. date/time ^ int. date/time plus 23hrs, 59 min,
  1.  ;& 59 seconds
  1.  S RASTOP=Y_"^"_Y(0)_"^"_(Y+.235959)
  1.  ;
  1.  F I="RASTRT","RASTOP","^TMP($J," S ZTSAVE(I)=""
  1.  K I D EN^XUTMDEVQ("START^RACMHIS","Rad/Nuc Med: Contrast Media History report",.ZTSAVE,,1)
  1.  I +$G(ZTSK)>0 W !!,"Task Number: "_ZTSK,!
  1.  ;
  1. KILL ;clean up symbol table
  1.  K DIR,DIROUT,DIRUT,DTOUT,DUOUT,POP,RADIC,RAQUIT,RASTOP,RASTRT,RAUTIL,X
  1.  K Y,ZTSAVE,ZTSK,^TMP($J,"RA PROC W/CM")
  1.  Q
  1.  ;
  1. START ;main body
  1.  S:$D(ZTQUEUED) ZTREQ="@"
  1.  S RAHD="Contrast Media Edit History By Procedure"
  1.  S $P(RALINE,"-",(IOM+1))="",RAPG=0,RADT=$$FMTE^XLFDT(DT,"1P")
  1.  W:$E(IOST,1,2)="C-" @IOF ;clear screen
  1.  D HDR S RAXIT=0,RAPNME=""
  1.  F  S RAPNME=$O(^TMP($J,"RA PROC W/CM",RAPNME)) Q:RAPNME=""  D  Q:RAXIT
  1.  .S RAXIT=$$S^%ZTLOAD() S:RAXIT ZTSTOP=1 Q:RAXIT
  1.  .S RAY=0
  1.  .F  S RAY=$O(^TMP($J,"RA PROC W/CM",RAPNME,RAY)) Q:'RAY  D  Q:RAXIT
  1.  ..S RAXIT=$$S^%ZTLOAD() S:RAXIT ZTSTOP=1 Q:RAXIT
  1.  ..S RAS=$P(RASTRT,U,3)
  1.  ..F  S RAS=$O(^RAMIS(71,RAY,"AUD","B",RAS)) Q:'RAS!(RAS>$P(RASTOP,U,3))  D  Q:RAXIT
  1.  ...S RAIEN=0
  1.  ...F  S RAIEN=$O(^RAMIS(71,RAY,"AUD","B",RAS,RAIEN)) Q:'RAIEN  D  Q:RAXIT
  1.  ....;get changed date/time, CM value, & user
  1.  ....S RAY(0)=$G(^RAMIS(71,RAY,"AUD",RAIEN,0))
  1.  ....S RAADT=$$FMTE^XLFDT($P(RAY(0),U),"1P"),RACMU=$P(RAY(0),U,2)
  1.  ....S RAX=$S($L(RACMU):$$CONTRAST(RACMU),1:"**User deleted all contrast media data**")
  1.  ....S:+$P(RAY(0),U,3) RAAU=$$GET1^DIQ(200,$P(RAY(0),U,3)_",",.01)
  1.  ....I $Y>(IOSL-4) D EOS Q:RAXIT
  1.  ....W !,$E(RAPNME,1,32),?33,RAADT,?55,$E($G(RAAU),1,24)
  1.  ....I $Y>(IOSL-4) D EOS Q:RAXIT
  1.  ....;display the past CM data value or that CM data has been deleted 
  1.  ....S X=RAX,DIWL=3,DIWR=70,DIWF="W" D ^DIWP,^DIWW K ^UTILITY($J,"W")
  1.  ....Q
  1.  ...Q
  1.  ..Q
  1.  .Q
  1. EXIT ;clean up symbol table, message to user
  1.  ;if there are no records to print, alert user
  1.  W:'$D(RAY(0))#2 !,$$CJ^XLFSTR("*** No Records To Print ***",IOM)
  1.  K DIW,DIWF,DIWL,DIWR,DIWT,DN,I,RAADT,RAAU,RACMU,RADT,RAHD,RAI,RAIEN
  1.  K RALINE,RAPG,RAPNME,RAS,RAXIT,RAX,RAY,X,Y,Z
  1.  Q
  1.  ;
  1. EOS ; end of screen dialog
  1.  I $E(IOST,1,2)="C-" D  Q:RAXIT
  1.  .K DIR,DIRUT,DTOUT,DUOUT
  1.  .S DIR(0)="E" D ^DIR S:$D(DIRUT) RAXIT=1
  1.  .K DIR,DIRUT,DTOUT,DUOUT
  1.  .Q
  1.  ;
  1.  ;'falls' into HDR...
  1.  ;
  1. HDR ; print header
  1.  W:RAPG @IOF S RAPG=RAPG+1
  1.  W !,$$CJ^XLFSTR(RAHD,IOM),!,"Run Date: ",RADT,?25,"From: ",$P(RASTRT,U,2),?45,"To: ",$P(RASTOP,U,2),?68,"Page ",RAPG
  1.  W !,"Procedure",?34,"Date/Time Changed",?55,"User",!?2,"Contrast Media"
  1.  W !,$$CJ^XLFSTR(RALINE,IOM)
  1.  Q
  1.  ;
  1. CONTRAST(RACMU) ;Return the current CM definition for this procedure delimited
  1.  ;by commas.
  1.  ;input: RACMU=internal value of CM; multiple CM references per string
  1.  ;             are possible
  1.  ;return: the external format of CM delimited by commas
  1.  N RAI,RAX S RAX=""
  1.  F RAI=1:1:$L(RACMU) D
  1.  .S RAX=RAX_$$EXTERNAL^DILFD(71.0125,.01,"",$E(RACMU,RAI))_", "
  1.  .Q
  1.  Q $P(RAX,", ",1,($L(RAX,", ")-1)) ;strip off that last ", "
  1.  ;