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

RAUTODC.m

Go to the documentation of this file. 
  1. RAUTODC ;HISC/GJC discontinue expired rad orders ;30 Jan 2018 9:01 AM
  1.  ;;5.0;Radiology/Nuclear Medicine;**135**;Mar 16, 1998;Build 7
  1.  ;
  1.  ; *** WORKING: INTERNAL ONLY ***
  1.  ;
  1. EN1 ;entry point for initial mass discontinue action
  1.  ;check for all imaging types no bulletins/alerts
  1.  ;EN^RABUL is the bulletin routine.
  1.  ;
  1.  ;Routine              IA          Type
  1.  ;-------------------------------------
  1.  ; $$EC^%ZOSV          10097        (S)
  1.  ; ^%ZTER               1621        (S)
  1.  ; $$S^%ZTLOAD         10063        (S)
  1.  ; $$*^XLFDT           10103        (S)
  1.  ; ^XMD                10070        (S) 
  1.  ; EN^XPAR              2263        (S)
  1.  ; ENVAL^XPAR           2263        (S)
  1.  ; $$KSP^XUPARAM        2541        (S)
  1.  ; OUT^XPDMENU(p1,p2)   1157        (S)
  1.  ; ENALL^DIK           10013        (S)
  1.  ;
  1.  ;
  1.  ; *************************************************************
  1.  ; *** now that we've disabled all the notifications we need ***
  1.  ; *** to restore them if we run into an error. so we set    ***
  1.  ; *** the error trap code                                   ***
  1.  S X="ERROR^RAUTODC",@^%ZOSF("TRAP")
  1.  ; *************************************************************
  1.  ;
  1.  ;OE/RR NOTIFICATIONS IEN/NAME: 26/IMAGING REQUEST CANCEL/HELD
  1.  ;
  1.  ;                  *** variable list ***
  1.  ;RA135TIME: flag that mass DC is running (see RABUL)
  1.  ;RAIEN    : IEN of 'IMAGING REQUEST CANCEL/HELD' notification
  1.  ;RADD21   : DATE DESIRED (Not guaranteed) value from "BDD" xref
  1.  ;RADUZ    : the user performing these action on file 75.1 (POSTMASTER)
  1.  ;RAEDTM   : end date for mass DC process (no bulletins; no notifications)
  1.  ;RAENT    : entity USR-DUZ, DIV-DUZ(2), SYS-domain, PKG-package
  1.  ;RAIEN    : IEN of IMAGING REQUEST CANCEL/HELD notification (26)
  1.  ;RANOTE   : array of the 'IMAGING REQUEST CANCEL/HELD' notification setting
  1.  ;RAOIFN   : IEN of the record in RAD/NUC MED ORDERS file 75.1
  1.  ;RAOREQST : the REQUEST STATUS of each order record hit in file 75.1
  1.  ;RAOSTS   : internal FM variable for DISCONTINUED (1) req'd for ^RAORDU
  1.  ;RAQUIT   : indicates if the mass dc has been stopped or ran past time
  1.  ;RAREQSTS : hold (3)/pending (5)/scheduled (8) - the REQUEST STATUS static string
  1.  ;           used to compare against each record's REQUEST STATUS value against
  1.  ;RASAV    : carbon copy of RANOTE, the original notification values (enabled/disabled)
  1.  ;         : used to reset notifications to their original settings when the process
  1.  ;           has finished, has errored or has stopped.
  1.  ;
  1.  ;w/o the reason we cannot go forward.
  1.  S RAOREA(1)=$$GETREA()
  1.  I RAOREA(1)'>0 D  K RAOREA Q
  1.  .N RAX S RAX(1)="'OBSOLETE ORDER-P135 (automated)' not found in file 75.2"
  1.  .D EMAIL(.RAX)
  1.  .Q
  1.  ;
  1.  ; check notifications against: OR PARAM COORDINATOR MENU
  1.  ;
  1.  N RAERR
  1.  ;
  1.  ;prevents bulletins from firing (RABUL in DD 75.1, fld: 5)
  1.  S RA135TIME=1
  1.  ;
  1.  S RAQUIT=0,RAREQSTS="^3^5^8^"
  1.  ;
  1.  ;--- get notifications ---
  1.  K RANOTE S RAPAR="ORB PROCESSING FLAG"
  1.  S RAINT="IMAGING REQUEST CANCEL/HELD"
  1.  D GETNOTE(.RANOTE,RAPAR,RAINT)
  1.  ;
  1.  ;RAERR is returned: RAERR=0 if no error, else error
  1.  I RAERR'=0 D  Q
  1.  .N RAX S RAX(1)="GETNOTE^RAUTODC failed."
  1.  .D EMAIL(.RAX)
  1.  .Q
  1.  ;--- end get notifications ---
  1.  ;
  1.  ;save off the original definition of the notification values in RASAV
  1.  K RASAV M RASAV=RANOTE
  1.  ;
  1.  ;must save off the original IMAGING REQUEST CANCEL/HELD notification definitions
  1.  ;in XTMP to ensure resetting them to their correct values in case of error.
  1.  S RADESC="RA5_0P135: save off the original value of the IMAGING REQUEST CANCEL/HELD notification per parameter"
  1.  K ^XTMP("RA5_0P135",0) S ^XTMP("RA5_0P135",0)=$$FMADD^XLFDT($$DT^XLFDT(),30,0,0,0)_"^"_$$DT^XLFDT()_"^"_RADESC
  1.  K RADESC M ^XTMP("RA5_0P135")=RANOTE
  1.  ;
  1.  ; RASAV save the original values of at each notification value @ each
  1.  ; level: user, team, service, location, division, system & package. 
  1.  ; disable notifications if set to enabled. Use RANOTE as the reference.
  1.  ; Place options 'Cancel a Request' & 'Hold a Request' out of order 
  1.  D DISABLE,OOO(1)
  1.  ;
  1.  K RAERR
  1.  ;
  1.  N RADD21,RADUZ S RADD21=0
  1.  S RADUZ=.5 ;POSTMASTER
  1.  ;
  1.  ;turn off notifications and bulletins for all events up to May 31st 2015@23:59
  1.  S RAEDTM=3150531.2359
  1.  ;
  1.  ; set to 'Discontinue' request status internal value
  1.  ; used when calling ^RAORDU (fixed value)
  1.  S RAOSTS=1
  1.  ;
  1.  ;track statistics: how many records, how long did it take?
  1.  S RAQST=$$NOW^XLFDT() ;start time w/seconds
  1.  S RAQDC=0 ;count the # of orders DC'd.
  1.  ;
  1.  ;"BDD" cross reference on the added w/RA*5.0*135
  1.  F  S RADD21=$O(^RAO(75.1,"BDD",RADD21)) Q:RADD21=""!(RADD21>RAEDTM)  D  Q:RAQUIT
  1.  .;
  1.  .S RAOIFN=0 F  S RAOIFN=$O(^RAO(75.1,"BDD",RADD21,RAOIFN)) Q:RAOIFN=""  D  Q:RAQUIT
  1.  ..S RAOIFN(0)=$G(^RAO(75.1,RAOIFN,0)) Q:RAOIFN(0)=""
  1.  ..;
  1.  ..;only hold (3)/pending (5)/scheduled (8) orders are DC'd
  1.  ..;RAREQSTS="^3^5^8^"
  1.  ..S RAOREQST=$P(RAOIFN(0),U,5)
  1.  ..Q:RAREQSTS'[(U_RAOREQST_U)
  1.  ..;
  1.  ..;
  1.  ..; Request Status='Scheduled' check the 'SCHEDULED DATE/TIME'
  1.  ..; 'DATE DESIRED (not Guaranteed)' fields
  1.  ..; if 'SCHEDULED DATE/TIME' > 05/31/2015@2359 -OR-
  1.  ..; 'DATE DESIRED (not Guaranteed)' > 06/01/2015
  1.  ..; quit
  1.  ..I RAOREQST=8,(($$8()>RAEDTM)) Q
  1.  ..;
  1.  ..;
  1.  ..; RAOIFN & RAOREA(n) are defined above. RAOSTS
  1.  ..; is set above (to a value of one) outside the
  1.  ..; RADD21 FOR loop above RAOIFN, RAOREA(n) & RADD21
  1.  ..; are required when calling ^RAORDU
  1.  ..D ^RAORDU
  1.  ..S RAQDC=RAQDC+1 ;increment the DC'd order total
  1.  ..Q
  1.  .;
  1.  .I $$S^%ZTLOAD() S (ZTSTOP,RAQUIT)=1 D  Q
  1.  ..;re-enable the notifications, place options back in order
  1.  ..D ENABLE,OOO(0)
  1.  ..S RATXT(1)="RA*5.0*135 mass DC process stopped: "_$$NOW^XLFDT()
  1.  ..D EMAIL(.RATXT) K RATXT
  1.  ..Q
  1.  .Q
  1.  ;
  1.  ;only remove the task from the task log if not stopped (ZTSTOP=0)
  1.  S:$D(ZTQUEUED)&($G(ZTSTOP,0)=0) ZTREQ="@"
  1.  ;
  1.  ; the process completed successfully: no error; not stopped
  1.  ; re-enable the notifications, place options back in order 
  1.  D:RAQUIT=0 ENABLE,OOO(0)
  1.  ;
  1.  D STATS ;track DC'd statistics, email results to proper audience
  1.  ;
  1. KILL ; Kill variables
  1.  K RA135TIME,RADD21,RADUZ,RAEDTM,RAENT,RAIEN,RANOTE,RAOIFN
  1.  K RAOREA,RAOREQST,RAQDC,RAQFIN,RAQST,RAQUIT,RAREQSTS,RASAV
  1.  Q
  1.  ;
  1.  ;                 *** utilities ***
  1.  ;
  1. GETREA() ;get the generic discontinue reason IEN
  1.  ;the record has a .01 of 'OBSOLETE ORDER-P135 (automated)'
  1.  ;the "B" xref stores 'OBSOLETE ORDER-P135 (automated' thirty chars
  1.  Q $O(^RA(75.2,"B","OBSOLETE ORDER-P135 (automated",0))
  1.  ;
  1. DISABLE ;disable the notifications that were enabled
  1.  S RAENT="" F  S RAENT=$O(RANOTE(RAENT)) Q:RAENT=""  D
  1.  .S RAIEN=$O(RANOTE(RAENT,0)) Q:RAIEN=0
  1.  .;RAIEN=IEN of the value 'IMAGING REQUEST CANCEL/HELD' `26
  1.  .D:$G(RANOTE(RAENT,RAIEN))'="D" NOTEVT(RAENT,1) ;disable
  1.  .;note: if not 'D'isabled then the notification
  1.  .;      is either 'E'nabled or 'M'andatory
  1.  .Q
  1.  Q
  1.  ;
  1. ENABLE ;enable the notifications that were disabled
  1.  N RAIEN,RAENT
  1.  S RAENT="" F  S RAENT=$O(RASAV(RAENT)) Q:RAENT=""  D
  1.  .S RAIEN=$O(RANOTE(RAENT,0)) Q:RAIEN=0
  1.  .;RAIEN should be the IEN of the value "IMAGING REQUEST CANCEL/HELD" `26
  1.  .;RASAV is the array of notifications defnitions before our total disable action
  1.  .D:$G(RASAV(RAENT,RAIEN))'="D" NOTEVT(RAENT,0) ;enable
  1.  .;note: if not 'E'nabled or 'M'andatory then the
  1.  .;      notification was 'D'isabled.
  1.  .Q
  1.  Q
  1.  ;
  1. 8() ;get SCHEDULED DATE (TIME optional) fld: #23
  1.  Q $P(RAOIFN(0),U,23)
  1.  ;
  1. GETNOTE(ARY,PAR,INST) ; gets both enabled & disabled
  1.  D ENVAL^XPAR(.ARY,PAR,INST,.RAERR)
  1.  ;RAERR is returned: RAERR=0 if no error, else error
  1.  I RAERR'=0 D
  1.  .N RATXT S RATXT(1)="RAERR = "_$G(RAERR),RATXT(2)="INST = "_INST
  1.  .S RATXT(3)="RANOTE = "_$G(RANOTE),RATXT(4)="PAR = "_PAR
  1.  .S RATXT(5)="Error @ GETNOTE^RAUTODC"
  1.  .D EMAIL(.RATXT)
  1.  Q
  1.  ;
  1. NOTEVT(RAENT,Y) ;
  1.  ;RAENT = array value of notification (#100.9) values
  1.  ; for "IMAGING REQUEST CANCEL/HELD"
  1.  ;Y = 1 disable, 0 enable
  1.  ;
  1.  ;RAIEN is global in scope RAIEN should be 26
  1.  N RAPAR,RAY S RAPAR="48"
  1.  I Y=1 S RAY="D"
  1.  E  S RAY=$G(RASAV(RAENT,RAIEN))
  1.  S RAY(0)=$S(RAY="D":"Disabled",RAY="E":"Enabled",1:"Mandatory")
  1.  D EN^XPAR(RAENT,RAPAR,RAIEN,.RAY,.ERR)
  1.  ;
  1.  Q
  1.  ;
  1. OOO(Y) ;place options 'Cancel a Request' & 'Hold a Request' in/out of order
  1.  ;input: Y = 1 to set options out of order (OOO)
  1.  ;       Y = 0 to set options back in order
  1.  S RAX=$S(Y=1:"<<< RA*5.0*135 >>>",1:"@")
  1.  F RAI="RA ORDERCANCEL","RA ORDERHOLD" D OUT^XPDMENU(RAI,RAX)
  1.  K RAI,RAX
  1.  Q
  1.  ;
  1. ERROR ;come here on error
  1.  N RAERR,RATXT
  1.  S RAERR=$$EC^%ZOSV ;get error code
  1.  ;record error
  1.  D ^%ZTER
  1.  ;restore notifications, place options back in order
  1.  D ENABLE,OOO(0)
  1.  ;build email
  1.  s RATXT(1)=$G(ZTDESC,"RA*5.0*135 part one")_" has encountered an error."
  1.  S RATXT(2)="$ZE: "_RAERR
  1.  ;send email
  1.  D EMAIL(.RATXT)
  1.  Q
  1.  ;
  1. EMAIL(RAX) ;email error to us
  1.  ;RAX = error text array
  1.  N D0,D1,DIC,XMDUN,XMDUZ,XMSUB,XMY
  1.  S XMY("greg.cebelinski@domain.ext")=""
  1.  S XMY("kerry.milligan@domain.ext")=""
  1.  S XMSUB="RA*5.0*135@"_$$KSP^XUPARAM("WHERE")
  1.  S XMDUZ=.5,XMTEXT="RAX("
  1.  D ^XMD S RAMSGNUM=XMZ
  1.  Q
  1.  ;
  1.  ;
  1. EN2 ; re-index the new 'DATE DESIRED (Not guaranteed)' (#21) "BDD" xref
  1.  ;
  1.  K DA,DIC,DIK S DIK="^RAO(75.1,",DIK(1)="21^BDD" D ENALL^DIK
  1.  K DA,DIC,DIK
  1.  Q
  1.  ;
  1. EN3 ; re-index the existing 'REQUEST STATUS' (#5) "AS" xref.
  1.  ;
  1.  K DA,DIC,DIK K ^RAO(75.1,"AS") ;kill the corrupted "AS" xref
  1.  S DIK="^RAO(75.1,",DIK(1)="5^AS" D ENALL^DIK
  1.  K DA,DIC,DIK
  1.  Q
  1.  ;
  1. STATS ;track DC'd statistics: how many records, how long did it take.
  1.  ; email to RA REQUEST CANCELLED & POSTMASTER.
  1.  ;
  1.  N I,RAQFIN,RATEXT,RAX,XMDUZ,XMMG,XMSUB,XMTEXT,XMY,XMZ
  1.  S RAX="DC'd order process ",XMDUZ=.5 ;postmaster
  1.  S RAQFIN=$$NOW^XLFDT() ;w/seconds
  1.  S XMSUB="RA135: # of DC'd orders over time statistics"
  1.  S RATEXT(1)=RAX_"started: "_$$FMTE^XLFDT(RAQST,"1P") ;RAQST is global
  1.  S RATEXT(2)=RAX_"finished: "_$$FMTE^XLFDT(RAQFIN,"1P")
  1.  S RATEXT(3)="Total # of orders DC'd: "_RAQDC,RATXT(4)=""
  1.  S RATEXT(5)="DC'd process duration: "_$$FMDIFF^XLFDT(RAQFIN,RAQST,3)
  1.  F I="G.RA REQUEST CANCELLED","POSTMASTER" S XMY(I)=""
  1.  S XMTEXT="RATEXT("
  1.  D ^XMD
  1.  Q
  1.  ;