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

RAORD.m

Go to the documentation of this file. 
  1. RAORD ;HISC/CAH,FPT,GJC AISC/RMO-Rad/NM Order Entry Main Menu ;3/13/98  12:16
  1.  ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
  1. 2 ;;Schedule a Request
  1.  N RAPTLOCK
  1. 21 ; Patient lookup
  1.  S DIC="^DPT(",DIC(0)="AEMQ" W ! D ^DIC K DIC G Q2:Y<0
  1.  I $$ORVR^RAORDU()'<3 D  G:'RAPTLOCK 21
  1.  . S RAPTLOCK=$$LK^RAUTL19(+Y_";DPT(")
  1.  . Q
  1.  S RADFN=+Y,RANME=$S($D(^DPT(RADFN,0)):$P(^(0),"^"),1:"Unknown")
  1.  S (RAOFNS,RAOPTN)="Schedule",RAOVSTS="3;5"
  1.  W ! D ^RAORDS G Q2:'$D(RAORDS)
  1.  S %DT("A")="Schedule Request Date/Time: ",%DT="AEFXT"
  1.  W ! D ^%DT K %DT G Q2:Y<0 S RAOSCH=Y,RAOLP=0
  1.  F  S RAOLP=+$O(RAORDS(RAOLP)) Q:'RAOLP!('+$G(RAORDS(RAOLP)))  D
  1.  . S RAOIFN=$G(RAORDS(RAOLP)),RAOSTS=8 D ^RAORDU
  1.  . Q
  1.  D Q2 G 21
  1. Q2 ; Unlock if appropriate, kill vars
  1.  I $$ORVR^RAORDU()'<3,(+$G(RAPTLOCK)),(+$G(RADFN)) D
  1.  . D ULK^RAUTL19(RADFN_";DPT(")
  1.  K %DT,C,D,D0,DA,I,RADFN,RADIV,RANME,RAOFNS,RAOIFN,RAOLP,RAORDS,RAOSCH
  1.  K RAOPTN,RAOSTS,RAOVSTS,X,Y
  1.  K RAPARENT
  1.  K A1,D1,DDER,DDH,DI,DIPGM,POP,^TMP($J,"PRO-ORD")
  1.  Q
  1.  ;
  1. 3 ;;Cancel a Request
  1.  N RAPTLOCK,RAXIT S RAXIT=0,RAPKG=""
  1. 31 ; Patient lookup
  1.  S DIC="^DPT(",DIC(0)="AEMQ" W ! D ^DIC K DIC G Q3:Y<0
  1.  I $$ORVR^RAORDU()'<3 D  G:'RAPTLOCK 31
  1.  . S RAPTLOCK=$$LK^RAUTL19(+Y_";DPT(")
  1.  . Q
  1.  S RADFN=+Y,RANME=$S($D(^DPT(RADFN,0)):$P(^(0),"^"),1:"Unknown")
  1.  S (RAOFNS,RAOPTN)="Cancel"
  1.  D CHKUSR^RAUTL2 S RAOVSTS=$S(RAMSG:"3;5;8",1:"5")
  1.  W ! D ^RAORDS G Q3:'$D(RAORDS)
  1.  D REASON G Q3:RAXIT!(+$G(OREND))
  1. ENCAN ;OE/RR Entry Point for the CANCEL ACTION Option
  1.  K ORSTRT,ORSTOP,ORTO,ORTX,ORIT,ORCOST,ORPURG
  1.  I $D(RAPKG) W !?3,"...will now 'CANCEL' selected request(s)..."
  1.  S RAOLP=0
  1.  F  S RAOLP=+$O(RAORDS(RAOLP)) Q:'RAOLP!('+$G(RAORDS(RAOLP)))  D
  1.  . S RAOIFN=$G(RAORDS(RAOLP)),RAOSTS=1 D ^RAORDU
  1.  . I $D(RAPKG),$D(^RAO(75.1,RAOIFN,0)),$D(^RAMIS(71,+$P(^(0),"^",2),0)) W !?10,"...",$P(^(0),"^")," cancelled..."
  1.  . ; Print Cancelled Requests if appropriate
  1.  . K RA751,RA791 S RA751=$G(^RAO(75.1,RAOIFN,0))
  1.  . S RA791=$G(^RA(79.1,+$P(RA751,"^",20),0))
  1.  . I $P(RA791,"^",24)]""!(+$P($G(^RA(79.1,+$O(^RA(79.1,0)),0)),"^",24)) D
  1.  .. K RACRHD,RAION,RAPGE,RAX S RAPGE=0,(RACRHD,RAX)=""
  1.  .. ; RAOIFN already defined, RADFN may/maynot be defined!
  1.  .. I '$D(RADFN) N RADFN S RADFN=+$P(RA751,"^")
  1.  .. S RAION=$S($P(RA791,"^",24)]"":$P(RA791,"^",24),1:+$P($G(^RA(79.1,+$O(^RA(79.1,0)),0)),"^",24))
  1.  .. S RAION=$$GET1^DIQ(3.5,RAION_",",.01)
  1.  .. D PCR ; Print Cancelled Request subroutine
  1.  .. K RACRHD,RAION,RAPGE,RAX
  1.  .. Q
  1.  . K RA751,RA791
  1.  . Q
  1. Q3 ; unlock if appropriate, kill variables
  1.  I $$ORVR^RAORDU()'<3,(+$G(RAPTLOCK)),(+$G(RADFN)) D
  1.  . D ULK^RAUTL19(RADFN_";DPT(")
  1.  K %,%DT,C,D,D0,DA,POP,RADFN,RADIV,RAMSG,RANME,RAOFNS,RAOIFN,RAOLP
  1.  K RAOPTN,RAORDS,RAOSTS,RAOVSTS I $D(RAPKG) K OREND,RAPKG
  1.  I '$D(N)!($D(RAOREA)<10) K RAPARENT,X,Y
  1.  I '$D(N)!($D(RAOREA)<10) K RAOREA G Q35
  1.  I $D(RAOREA)>1,$G(N) K RAOREA(N),N I $D(RAOREA)<10 K RAOREA
  1.  K RAPARENT,X,Y
  1. Q35 K DIPGM,I
  1.  Q
  1. CHECK ; Check on the status of the order
  1.  S OREND=$S(ORSTS=5:0,ORSTS=11:0,1:1) W:OREND !!,"Only orders in a Pending or Unreleased status can be cancelled.",$C(7)
  1.  Q
  1. REASON ; Select a Cancel Reason
  1.  S DIC("A")="Select CANCEL REASON: ",DIC("S")="I $P(^(0),U,2)=1!($P(^(0),U,2)=9)",DIC="^RA(75.2,",DIC(0)="AEMQ"
  1.  W ! D ^DIC K DIC
  1.  I +Y<0,(X["^") S RAXIT=1 Q
  1.  I +Y<0 W !!?3,"A Cancel Reason is required to proceed." G REASON
  1.  S OREND=0,RAOREA($S($D(ORPK):ORPK,$D(ORIFN):ORIFN,1:1))=+Y
  1.  Q
  1. 4 ;;Hold a Request
  1.  N RAPTLOCK
  1. 40 ; Patient lookup
  1.  S DIC="^DPT(",DIC(0)="AEMQ" W ! D ^DIC K DIC G Q4:Y<0
  1.  I $$ORVR^RAORDU()'<3 D  G:'RAPTLOCK 40
  1.  . S RAPTLOCK=$$LK^RAUTL19(+Y_";DPT(")
  1.  . Q
  1.  S RADFN=+Y,RANME=$S($D(^DPT(RADFN,0)):$P(^(0),"^"),1:"Unknown")
  1.  S (RAOFNS,RAOPTN)="Hold",RAOVSTS="5;8"
  1.  W ! D ^RAORDS G Q4:'$D(RAORDS)
  1. 41 ; Select a Hold Reason
  1.  S DIC("A")="Select HOLD REASON: ",DIC("S")="I $P(^(0),U,2)=3!($P(^(0),U,2)=9)",DIC="^RA(75.2,",DIC(0)="AEMQ" W ! D ^DIC K DIC
  1.  I +Y<0,(X["^") D Q4 Q
  1.  I +Y<0 W !!?3,"A Hold Reason is required to proceed." G 41
  1.  S RAOREA=+Y
  1.  W !?3,"...will now 'HOLD' selected request(s)..." S RAOLP=0
  1.  F  S RAOLP=+$O(RAORDS(RAOLP)) Q:'RAOLP!('+$G(RAORDS(RAOLP)))  D
  1.  . S RAOIFN=$G(RAORDS(RAOLP)),RAOSTS=3 D ^RAORDU
  1.  . I $D(^RAO(75.1,RAOIFN,0)),$D(^RAMIS(71,+$P(^(0),"^",2),0)) W !?10,"...",$P(^(0),"^")," held..."
  1.  . Q
  1.  D Q4 G 40
  1. Q4 ; unlock if appropriate, kill variables
  1.  I $$ORVR^RAORDU()'<3,(+$G(RAPTLOCK)),(+$G(RADFN)) D
  1.  . D ULK^RAUTL19(RADFN_";DPT(")
  1.  K %DT,C,D,D0,DA,I,POP,RADFN,RADIV,RANME,RAOFNS,RAOIFN,RAOLP,RAORDS
  1.  K RAOPTN,RAOREA,RAOSTS,RAOVSTS,X,Y
  1.  K D1,DDER,DI,DIPGM,DISYS,DUOUT,RAPARENT,^TMP($J,"PRO-ORD"),^("XQALSET")
  1.  Q
  1.  ;
  1. 9 ;;Print Selected Requests by Patient
  1.  K ^TMP($J,"RA PRINT HS BY PAT")
  1.  S DIC="^DPT(",DIC(0)="AEMQ" W ! D ^DIC K DIC G Q9:Y<0 S RADFN=+Y,RANME=$S($D(^DPT(RADFN,0)):$P(^(0),"^"),1:"Unknown"),RAOFNS="Print",RAOVSTS="1;2;3;5;6;8" W ! D ^RAORDS G Q9:'$D(RAORDS)
  1.  S RAOIFNS="" F RAOLP=1:1 Q:'$D(RAORDS(RAOLP))  S RAOIFNS=RAOIFNS_+RAORDS(RAOLP)_";"
  1.  W ! K DIR,DIROUT,DIRUT,DTOUT,DUOUT
  1.  S DIR(0)="Y",DIR("B")="No"
  1.  S DIR("?")="Answer 'Y'es to print the report, 'N'o to quit."
  1.  S DIR("A")="Do you wish to generate a Health Summary Report"
  1.  D ^DIR G:$D(DIRUT) Q9 S RAGMTS=+Y
  1.  S ZTRTN="START9^RAORD",ZTSAVE("RADFN")="",ZTSAVE("RAOIFNS")=""
  1.  S ZTSAVE("RAGMTS")="" S:$D(RAOPT) ZTSAVE("RAOPT(")=""
  1.  W ! D ZIS^RAUTL G Q9:RAPOP
  1.  ;
  1. START9 ; Start printing requests
  1.  U IO S RAX="" N RA751
  1.  F RAOLP=1:1 S RAOIFN=$P(RAOIFNS,";",RAOLP) Q:'RAOIFN!(RAX["^")  D
  1.  . S RAPGE=0 D ^RAORD5 Q:RAX["^"
  1.  . D CRCHK^RAORD6 Q:RAX["^"
  1.  . Q:'RAGMTS  ; quit if 'No' to 'generate a Health Summary Report'.
  1.  . S RA751(0)=$G(^RAO(75.1,RAOIFN,0)),RA751(2)=$P(RA751(0),"^",2)
  1.  . S GMTSTYP=$P($G(^RAMIS(71,+RA751(2),0)),"^",13)
  1.  . I GMTSTYP>0,('$D(^TMP($J,"RA PRINT HS BY PAT",GMTSTYP,RADFN))) D
  1.  .. W:$Y>0 @IOF D ENX^GMTSDVR(RADFN,GMTSTYP)
  1.  .. S ^TMP($J,"RA PRINT HS BY PAT",GMTSTYP,RADFN)=""
  1.  .. Q
  1.  . Q
  1. Q9 K %DT,C,D,D0,DA,DFN,GMTSTYP,I,POP,RACNI,RADFN,RADIV,RADTI,RANME,RAOFNS
  1.  K RAOIFN,RAOIFNS,RAOLP,RAORDS,RAOSTS,RAOVSTS,RAPARENT,RAPGE,RAPOP,RAX
  1.  K RAGMTS,VAI,VAIN,X,Y,Z,^TMP($J,"RA PRINT HS BY PAT")
  1.  K RAMES,ZTDESC,ZTRTN,ZTSAVE
  1.  K DIR,DIROUT,DIRUT,DTOUT,DUOUT
  1.  K DIPGM,DISYS,DIW,DIWT,DN,RA6,RA7,^TMP($J,"PRO-ORD")
  1.  W ! D CLOSE^RAUTL
  1.  Q
  1. KILL ; kill variables - called from RAORD1
  1.  K %,%DT,D,D0,D1,DA,DFN,DIC,DIK,DIROUT,DIRUT,DIV,DR,DTOUT,DUOUT,DWPK,J,OREND,RABLNK,RACNT,RACT,RADIV,RAEXMUL,RAFIN,RAFIN1,RAI,RAILOC,RAIMGTYI,RAIP,RAJ,RAL0,RALOC,RALIFN,RALOCFLG
  1.  K RAMOD,RAMT,RANUM,RAOIFN,RAORD0,RAOUT,RAPIFN,RAPRC,RAPRI,RAPREG,RAPREOP1,RAREASK,RAREQDT,RAREQPRT,RARU,RARX,RASEQ,RAS3,RASEX,RASKPREG,RASTOP,RASX,RAWHEN,RAX,VAERR,VA200,VAI,VAIP,X,Y
  1.  K RAACI
  1.  I '$D(RAPKG),$G(XQORS)>1,$G(^TMP("XQORS",$J,XQORS-1,"ITM"))'=$G(^("TOT")) Q  ;don't kill clin hist if order entry quick orders not all proccessed
  1.  K ^TMP($J,"RAWP")
  1.  Q
  1. PCR ; Print Cancelled Requests.  Called from the 'Cancel A Request' option.
  1.  N I,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
  1.  S ZTDESC="Rad/Nuc Med Cancelled Request Print",ZTDTH=$H,ZTIO=RAION
  1.  S ZTRTN="^RAORD5"
  1.  F I="RACRHD","RADFN","RAOIFN","RAPGE","RAX" S ZTSAVE(I)=""
  1.  D ^%ZTLOAD W:$D(ZTSK) !!?3,$C(7),"Task "_ZTSK_": cancellation queued to print on device ",RAION,!
  1.  D HOME^%ZIS
  1.  Q