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

RAORDR2.m

Go to the documentation of this file. 
  1. RAORDR2 ;ABV/SCR/MKN - Refer Pending/Hold Requests Reason for Request ; Jul 08, 2022@13:00:02
  1.  ;;5.0;Radiology/Nuclear Medicine;**148,161,170,190**;Mar 16, 1998;Build 1
  1.  ;
  1.  ; Routine/File         IA          Type
  1.  ; -------------------------------------
  1.  ; DETAIL^ORWOR        NONE
  1.  ; ^OR(100             5771,6475     (C)
  1.  ;
  1.  ;
  1. GETREAS ;Get Reason
  1.  N RAARRAY,RACOUNT,RAERR,RAFILE,RAI,RAL,RAMED,RANEXT,RARTRN1
  1.  S RAIENS=RAOIFN_","
  1.  S RAFILE=100.008 ;get order actions
  1.  S RAFIELDS=".01;.1;2;3;4;5;6;12;13;16;17" ;only using .01,2,3,5,6,12
  1.  S RACOUNT=1,RANEXT=0
  1.  F  S RANEXT=$O(^OR(100,RAORDIEN,8,RANEXT)) Q:'+RANEXT  D
  1.  .S RAIENS=RANEXT_","_RAORDIEN_","
  1.  .S RAFIELDS=".01;2;3;7;12;13;21;22;"
  1.  .D GETS^DIQ(RAFILE,RAIENS,RAFIELDS,"E","RARTRN1","RAERR")
  1.  S RAX=$O(^RA(75.2,"B","COMMUNITY CARE APPT",""))
  1.  D:RAX?1.N
  1.  .S ORDIALOG("WP",RAWPN,1,RACOUNT,0)="",RACOUNT=RACOUNT+1
  1.  .S ORDIALOG("WP",RAWPN,1,RACOUNT,0)="  ** Radiology Order placed on hold due to COMMUNITY CARE APPT **",RACOUNT=RACOUNT+1
  1.  .S ORDIALOG("WP",RAWPN,1,RACOUNT,0)="",RACOUNT=RACOUNT+1
  1.  .S ORDIALOG("WP",RAWPN,1,RACOUNT,0)="  Date/Time Ordered: "_$G(RARTRN1(100.008,RAIENS,.01,"E"))_" "_$G(RARTRN1(100.008,RAIENS,2,"E"))_" order entered by "_$G(RARTRN1(100.008,RAIENS,3,"E"))
  1.  .S ORDIALOG("WP",RAWPN,1,RACOUNT+1,0)=""
  1.  .S RACOUNT=RACOUNT+2
  1.  .S ORDIALOG("WP",RAWPN,1,RACOUNT,0)="  Nature of Order: "_$G(RARTRN1(100.008,RAIENS,12,"E"))
  1.  .S ORDIALOG("WP",RAWPN,1,RACOUNT+1,0)=""
  1.  .S RACOUNT=RACOUNT+2
  1.  .S ORDIALOG("WP",RAWPN,1,RACOUNT,0)="  Elec Signature: "_$G(RARTRN1(100.008,RAIENS,5,"E"))_" on "_$G(RARTRN1(100.008,RAIENS,6,"E"))
  1.  S ORDIALOG("WP",RAWPN,1,RACOUNT+1,0)=""
  1.  S RACOUNT=RACOUNT+2
  1.  D GETINFO^RAORDR(.RAARAY) Q:RAQUIT
  1.  S ORDIALOG("WP",RAWPN,1,RACOUNT,0)="  Justification for Community Care:"
  1.  S RACOUNT=RACOUNT+1
  1.  ;P170 - CC Justifications redone
  1.  S ORDIALOG("WP",RAWPN,1,RACOUNT,0)="    "_$P(RAREAS,U,2)
  1.  I $D(RAEXP) D
  1.  .K RAL D BRKLINE^RAORDR(.RAL,"    "_RAEXP,70)
  1.  .D SETLINES
  1.  .Q
  1.  S ORDIALOG("WP",RAWPN,1,RACOUNT+1,0)=""
  1.  S RACOUNT=RACOUNT+2
  1.  S ORDIALOG("WP",RAWPN,1,RACOUNT,0)="  Type of Service: "_$P(RAARAY("TYPEOFSERVICE"),U,2)
  1.  S ORDIALOG("WP",RAWPN,1,RACOUNT+1,0)=""
  1.  S RACOUNT=RACOUNT+2
  1.  S RANEXT=0
  1.  S ORDIALOG("WP",RAWPN,1,RACOUNT,0)="  Category: "_RAORTYP
  1.  S ORDIALOG("WP",RAWPN,1,RACOUNT+1,0)=""
  1.  S RACOUNT=RACOUNT+2
  1.  S ORDIALOG("WP",RAWPN,1,RACOUNT,0)="  Ordering Location: "_RAORDLOC
  1.  S ORDIALOG("WP",RAWPN,1,RACOUNT+1,0)=""
  1.  S RACOUNT=RACOUNT+2
  1.  I RAORPRE'="" D
  1.  .S ORDIALOG("WP",RAWPN,1,RACOUNT,0)="  Pre-Op Scheduled Date/Time: "_RAORPRE
  1.  .S ORDIALOG("WP",RAWPN,1,RACOUNT+1,0)=""
  1.  .S RACOUNT=RACOUNT+2
  1.  I RAORPREG'="" D 
  1.  .S ORDIALOG("WP",RAWPN,1,RACOUNT,0)="  Pregnant: "_RAORPREG
  1.  .S ORDIALOG("WP",RAWPN,1,RACOUNT+1,0)=""
  1.  .S RACOUNT=RACOUNT+2
  1.  S ORDIALOG("WP",RAWPN,1,RACOUNT,0)="  Date Desired (not guaranteed): "_RAORWANT
  1.  S ORDIALOG("WP",RAWPN,1,RACOUNT+1,0)=""
  1.  S RACOUNT=RACOUNT+2
  1.  I $G(RAARAY("THIRDPARTY")) D
  1.  .S ORDIALOG("WP",RAWPN,1,RACOUNT,0)="  Third Party: "_$P(RAARAY("THIRDPARTY"),U,2)
  1.  .S ORDIALOG("WP",RAWPN,1,RACOUNT+1,0)=""
  1.  .S RACOUNT=RACOUNT+2
  1.  I $G(RAARAY("TRAUMA")) D
  1.  .S ORDIALOG("WP",RAWPN,1,RACOUNT,0)="  History of Trauma :"_$P(RAARAY("TRAUMA"),U,2)
  1.  .S RANEXT=0
  1.  .F  S RANEXT=$O(RAARAY("TRAUMA",RANEXT)) Q:RANEXT=""  D
  1.  . .S ORDIALOG("WP",RAWPN,1,RACOUNT+1,0)=""
  1.  . .S RACOUNT=RACOUNT+2
  1.  . .S ORDIALOG("WP",RAWPN,1,RACOUNT,0)=RAARAY("TRAUMA",RANEXT)
  1.  D ORDDET
  1.  Q
  1.  ;
  1. ORDDET ;Get Order Detail
  1.  N RACR,RAHDORD,RAN,RAHDORD,RAOUT,RAX,RAY
  1.  S RAX="",$P(RAX,"-",79)=""
  1.  S ORDIALOG("WP",RAWPN,1,RACOUNT,0)=" ",RACOUNT=RACOUNT+1
  1.  S RAY="Radiology order details "
  1.  S ORDIALOG("WP",RAWPN,1,RACOUNT,0)=RAY_$E(RAX,1,79-$L(RAY)),RACOUNT=RACOUNT+1
  1.  S RAY="Radiology order IEN:"_RAORDIEN
  1.  S ORDIALOG("WP",RAWPN,1,RACOUNT,0)=RAY,RACOUNT=RACOUNT+1
  1.  S ORDIALOG("WP",RAWPN,1,RACOUNT,0)="",RACOUNT=RACOUNT+1
  1.  D DETAIL^ORWOR(.RAOUT,RAORDIEN,RAORVP)
  1.  S RAN=0 F  S RAN=$O(@RAOUT@(RAN)) Q:'RAN  D
  1.  .S ORDIALOG("WP",RAWPN,1,RACOUNT,0)=@RAOUT@(RAN),RACOUNT=RACOUNT+1,ORDIALOG("WP",RAWPN,1,RACOUNT,0)="",RACOUNT=RACOUNT+1
  1.  S RAY="RAD"_$E(RAX,1,76)
  1.  S ORDIALOG("WP",RAWPN,1,RACOUNT,0)=RAY,RACOUNT=RACOUNT+1,ORDIALOG("WP",RAWPN,1,RACOUNT,0)="",RACOUNT=RACOUNT+1
  1.  Q
  1.  ;
  1. SETLINES ;
  1.  S RAI="" F  S RAI=$O(RAL(RAI)) Q:'RAI  S RACOUNT=RACOUNT+1,ORDIALOG("WP",RAWPN,1,RACOUNT,0)="    "_RAL(RAI)
  1.  Q
  1.  ;
  1. GETILOC(RAITYP) ;p170 returns imaging location
  1.  ;It's possible for the order to not have a 'submit to' location, in which case we'll try to
  1.  ;determine a location based on imaging type and user's division or prompt the user.
  1.  ;Also come here if I-LOC from order has no CCC
  1.  ;RAITYP   :Imaging Type from the radiology order (#79.2)
  1.  ;Returns an Imaging Location (#79.1)
  1.  Q:'$D(RAITYP)
  1.  N RAOILOC,RAIL,RAILS,RAS,RASOC,RAUDIV S RAUDIV=DUZ(2) I $D(RAUDIV) D
  1.  .S RAIL="" F  Q:$G(RAOILOC)]""  S RAIL=$O(^RA(79,RAUDIV,"L","B",RAIL)) Q:RAIL=""  D
  1.  ..I RAITYP=$$GET1^DIQ(79.1,RAIL,6,"I")&($O(^RA(79.1,RAIL,"CON",0))) S RAOILOC=RAIL
  1.  ..Q
  1.  .Q
  1.  I $G(RAOILOC)="" D  ;still no location?  Lets prompt the user...
  1.  .D LOCSCRN
  1.  .I $D(RAILS) D
  1.  ..W !,"Please select the "_$$GET1^DIQ(79.2,RAITYP,.01)_" location you want to use.",!
  1.  ..S (RAS,RASOC)="" F  S RAS=$O(RAILS(RAS)) Q:RAS=""  D
  1.  ...S RASOC=RASOC_RAS
  1.  ...Q
  1.  ..N DIR,Y,DIRUT S DIR(0)="S^"_RASOC D ^DIR Q:$D(DIRUT)
  1.  ..S RAOILOC=$G(RAILS(+Y_":"_Y(0)_";"))
  1.  ..Q
  1.  .E  W !!,"There are no consult titles associated with "_$$GET1^DIQ(79.2,RAITYP,.01)_".",!,"Please contact your Radiology ADPAC." Q
  1.  .Q
  1.  Q $S($G(RAOILOC)>0:RAOILOC,1:0)
  1. CCCHK(RADA,RAY) ;p161 -input transform for entering cc consults to the Imaging Location
  1.  ;Matched on I-TYPE for location and Naming Convention.
  1.  ;Ex: COMMUNITY CARE-IMAGING GENERAL RADIOLOGY-AUTO
  1.  ;Allows for site identifier appension
  1.  ;RADA = ILOC
  1.  N RAITYP,RACON,RASTR,RAM
  1.  S RAITYP=$$GET1^DIQ(79.1,RADA,6) S:RAITYP="CT SCAN" RAITYP="CT"
  1.  S RASTR=$P(^GMR(123.5,RAY,0),U)
  1.  S RACON="COMMUNITY CARE-IMAGING "_RAITYP
  1.  I RAITYP="MAMMOGRAPHY" Q $S(($P(RASTR," DIAGNOSTIC-AUTO",1)=RACON)!($P(RASTR," SCREEN-AUTO",1)=RACON):1,1:0)
  1.  E  Q $S($P(RASTR,"-AUTO",1)=RACON:1,1:0)
  1.  ;
  1. LOCSCRN() ;Screen for user prompt to select the i-loc for the order referral
  1.  N RAI,RAC S (RAI,RAC)=0
  1.  F  S RAI=$O(^RA(79.1,"BIMG",RAITYP,RAI)) Q:RAI=""  D
  1.  .Q:$P(^RA(79.1,RAI,0),U,19)]""  ;inactive
  1.  .Q:'$O(^RA(79.1,RAI,"CON",0))  ;no CCC
  1.  .S RAC=RAC+1 ;ctr
  1.  .S RAILS(RAC_":"_$$GET1^DIQ(79.1,RAI,.01)_";")=RAI
  1.  .Q
  1.  Q