RAIPS196 ;WOIFO/KLM - PostInit 196 ; Dec 08, 2022@11:47:48
;;5.0;Radiology/Nuclear Medicine;**196**;Mar 16, 1998;Build 1
;
; This post-install routine will loop through all HELD,
; COMPLETED, and DISCONTINUED Radiology orders and determine
; if they've been referred to community care via the auto
; referral option. If so, the REFERRED TO COMMUNITY CARE?
; field (#201) will be set to YES.
;
;
; Field #201 in file #75.1 is new with patch RA*5*196
;
; File/API IA Type
; -------------------------------------
; ^OR(100,D0,8,D1 6475 (P)
; ^GMR(123 6116 (C)
; INSTALDT^XPDUTL 10141 (S)
; SENDMSG^XMXAPI 2729 (S)
;
EN1 ;entry point from KIDS
N RATXT,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE S ZTIO=""
S ZTRTN="TASK^RAIPS196",(ZTDESC,RATXT(1))="RA196: Identify auto referred orders to community care"
S ZTDTH=$H D ^%ZTLOAD S RATXT(2)="Task: "_$S($G(ZTSK)>0:ZTSK,1:"in error")
D BMES^XPDUTL(.RATXT)
Q
;
TASK ;Task entry point
N RATEXT
D ORDERCHK ;Check referred order
D MSG
Q
ORDERCHK ;search for held, completed and discontinued referred orders
N RA148DT,RAODD,RAR,RAOIEN,RAORDA,RAERR,RARC,RAEC,RATC,RAIENS,RAFDA,RAORACT
N RASQ,RASPACE,RACODE,RAEIEN,RAERTX,RAL
F RASQ=1:1:50 S RASPACE=$G(RASPACE)_" "
S (RARC,RAEC,RATC)=0
D INSTALDT^XPDUTL("RA*5.0*148",.RAR)
Q:RAR<1 ;148 not installed
S RA148DT=$P($O(RAR(0)),".") Q:RA148DT="" ;no install date
S RAODD=RA148DT F S RAODD=$O(^RAO(75.1,"BDD",RAODD)) Q:RAODD="" D
.S RAOIEN="" F S RAOIEN=$O(^RAO(75.1,"BDD",RAODD,RAOIEN)) Q:RAOIEN="" D
..I "^1^2^3^"'[$P(^RAO(75.1,RAOIEN,0),U,5) Q
..S RAORDA=$P(^RAO(75.1,RAOIEN,0),U,7) Q:RAORDA=""
..S RAORDA=RAORDA_",",RATC=RATC+1 ;increment total counter
..K RAORACT D GETS^DIQ(100,RAORDA,".8*","N","RAORACT") ;order actions
..I '$D(RAORACT) Q
..I $$CHKORACT(.RAORACT) D
...K RAIENS,RAFDA
...S RAIENS=RAOIEN_"," S RAFDA(75.1,RAIENS,201)="YES"
...K RAERR D FILE^DIE("EK","RAFDA","RAERR")
...I $D(RAERR) S RATEXT(10)="There was a problem updating some orders:" D
....S RATEXT(12)="ORDER IEN ERROR"
....S RATEXT(13)="---------------- ------------------------------------------"
....S RAEIEN=+$G(RAERR("DIERR",1,"PARAM","IENS")),RAL=$L(RAEIEN),RAEC=RAEC+1
....S RAERTX=$E($G(RAERR("DIERR",1,"TEXT",1)),1,42)
....S RACODE=$G(RAERR("DIERR",1))
....S RATEXT(13+RAEC)=RAEIEN_$E(RASPACE,1,18-RAL)_"("_RACODE_") "_RAERTX
....Q
...E S RARC=RARC+1 ;increment referred counter
...Q
..Q
.Q
S RATEXT(8)="Total orders checked: "_RATC
I RARC>0 S RATEXT(9)="Total orders updated: "_RARC
E S RATEXT(9)="There were no auto referred orders found to update."
;ZW RATEXT
Q
CHKORACT(RAORACT) ;Check if order was referred using our option
N RACOM,RAIENS,RAQ,RA123 S RAQ=0
S RAIENS="" F S RAIENS=$O(RAORACT(100.008,RAIENS)) Q:RAIENS="" D
.S RACOM=$G(RAORACT(100.008,RAIENS,1))
.I RACOM["Placed on hold due to transfer to Community Care with UCID" D
..S RA123=$P(RACOM,"UCID",2) Q:'$D(RA123)
..S RA123=$P(RA123,"_",2) I RA123?1.N,$D(^GMR(123,RA123)) S RAQ=1
..Q
.Q
Q RAQ
MSG ;send results via Mailman
N RAID,RASUB,RAREC,RAINSTR
I '$D(RATEXT) S RATEXT(8)="*** No referred orders found! ***"
;Mail message introductory blurb...
S RATEXT(1)="The Post-Init task for RA*5.0*196 searched for radiology"
S RATEXT(2)="orders in a complete, discontinued or held status that"
S RATEXT(3)="have previously been referred to community care using"
S RATEXT(4)="the Refer Selected Requests to COMMUNITY CARE Provider"
S RATEXT(5)="option. Orders previously referred using this option"
S RATEXT(6)="had the new Referred to Community Care? field set to YES."
S RATEXT(7)="",RATEXT(11)=""
;XMTEXT for message text
;S XMTEXT="RATEXT("
S RASUB="RAD/NUC MED RA*5.0*196 Post-Install Information"
S RAID=+$G(DUZ)
S RAREC(RAID)="" ;send to installer
S RAINSTR("FROM")="RA*5.0*196 Post-Install"
D SENDMSG^XMXAPI(RAID,RASUB,"RATEXT",.RAREC,.RAINSTR,,)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAIPS196 4044 printed Sep 23, 2025@20:12:19 Page 2
RAIPS196 ;WOIFO/KLM - PostInit 196 ; Dec 08, 2022@11:47:48
+1 ;;5.0;Radiology/Nuclear Medicine;**196**;Mar 16, 1998;Build 1
+2 ;
+3 ; This post-install routine will loop through all HELD,
+4 ; COMPLETED, and DISCONTINUED Radiology orders and determine
+5 ; if they've been referred to community care via the auto
+6 ; referral option. If so, the REFERRED TO COMMUNITY CARE?
+7 ; field (#201) will be set to YES.
+8 ;
+9 ;
+10 ; Field #201 in file #75.1 is new with patch RA*5*196
+11 ;
+12 ; File/API IA Type
+13 ; -------------------------------------
+14 ; ^OR(100,D0,8,D1 6475 (P)
+15 ; ^GMR(123 6116 (C)
+16 ; INSTALDT^XPDUTL 10141 (S)
+17 ; SENDMSG^XMXAPI 2729 (S)
+18 ;
EN1 ;entry point from KIDS
+1 NEW RATXT,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
SET ZTIO=""
+2 SET ZTRTN="TASK^RAIPS196"
SET (ZTDESC,RATXT(1))="RA196: Identify auto referred orders to community care"
+3 SET ZTDTH=$HOROLOG
DO ^%ZTLOAD
SET RATXT(2)="Task: "_$SELECT($GET(ZTSK)>0:ZTSK,1:"in error")
+4 DO BMES^XPDUTL(.RATXT)
+5 QUIT
+6 ;
TASK ;Task entry point
+1 NEW RATEXT
+2 ;Check referred order
DO ORDERCHK
+3 DO MSG
+4 QUIT
ORDERCHK ;search for held, completed and discontinued referred orders
+1 NEW RA148DT,RAODD,RAR,RAOIEN,RAORDA,RAERR,RARC,RAEC,RATC,RAIENS,RAFDA,RAORACT
+2 NEW RASQ,RASPACE,RACODE,RAEIEN,RAERTX,RAL
+3 FOR RASQ=1:1:50
SET RASPACE=$GET(RASPACE)_" "
+4 SET (RARC,RAEC,RATC)=0
+5 DO INSTALDT^XPDUTL("RA*5.0*148",.RAR)
+6 ;148 not installed
if RAR<1
QUIT
+7 ;no install date
SET RA148DT=$PIECE($ORDER(RAR(0)),".")
if RA148DT=""
QUIT
+8 SET RAODD=RA148DT
FOR
SET RAODD=$ORDER(^RAO(75.1,"BDD",RAODD))
if RAODD=""
QUIT
Begin DoDot:1
+9 SET RAOIEN=""
FOR
SET RAOIEN=$ORDER(^RAO(75.1,"BDD",RAODD,RAOIEN))
if RAOIEN=""
QUIT
Begin DoDot:2
+10 IF "^1^2^3^"'[$PIECE(^RAO(75.1,RAOIEN,0),U,5)
QUIT
+11 SET RAORDA=$PIECE(^RAO(75.1,RAOIEN,0),U,7)
if RAORDA=""
QUIT
+12 ;increment total counter
SET RAORDA=RAORDA_","
SET RATC=RATC+1
+13 ;order actions
KILL RAORACT
DO GETS^DIQ(100,RAORDA,".8*","N","RAORACT")
+14 IF '$DATA(RAORACT)
QUIT
+15 IF $$CHKORACT(.RAORACT)
Begin DoDot:3
+16 KILL RAIENS,RAFDA
+17 SET RAIENS=RAOIEN_","
SET RAFDA(75.1,RAIENS,201)="YES"
+18 KILL RAERR
DO FILE^DIE("EK","RAFDA","RAERR")
+19 IF $DATA(RAERR)
SET RATEXT(10)="There was a problem updating some orders:"
Begin DoDot:4
+20 SET RATEXT(12)="ORDER IEN ERROR"
+21 SET RATEXT(13)="---------------- ------------------------------------------"
+22 SET RAEIEN=+$GET(RAERR("DIERR",1,"PARAM","IENS"))
SET RAL=$LENGTH(RAEIEN)
SET RAEC=RAEC+1
+23 SET RAERTX=$EXTRACT($GET(RAERR("DIERR",1,"TEXT",1)),1,42)
+24 SET RACODE=$GET(RAERR("DIERR",1))
+25 SET RATEXT(13+RAEC)=RAEIEN_$EXTRACT(RASPACE,1,18-RAL)_"("_RACODE_") "_RAERTX
+26 QUIT
End DoDot:4
+27 ;increment referred counter
IF '$TEST
SET RARC=RARC+1
+28 QUIT
End DoDot:3
+29 QUIT
End DoDot:2
+30 QUIT
End DoDot:1
+31 SET RATEXT(8)="Total orders checked: "_RATC
+32 IF RARC>0
SET RATEXT(9)="Total orders updated: "_RARC
+33 IF '$TEST
SET RATEXT(9)="There were no auto referred orders found to update."
+34 ;ZW RATEXT
+35 QUIT
CHKORACT(RAORACT) ;Check if order was referred using our option
+1 NEW RACOM,RAIENS,RAQ,RA123
SET RAQ=0
+2 SET RAIENS=""
FOR
SET RAIENS=$ORDER(RAORACT(100.008,RAIENS))
if RAIENS=""
QUIT
Begin DoDot:1
+3 SET RACOM=$GET(RAORACT(100.008,RAIENS,1))
+4 IF RACOM["Placed on hold due to transfer to Community Care with UCID"
Begin DoDot:2
+5 SET RA123=$PIECE(RACOM,"UCID",2)
if '$DATA(RA123)
QUIT
+6 SET RA123=$PIECE(RA123,"_",2)
IF RA123?1.N
IF $DATA(^GMR(123,RA123))
SET RAQ=1
+7 QUIT
End DoDot:2
+8 QUIT
End DoDot:1
+9 QUIT RAQ
MSG ;send results via Mailman
+1 NEW RAID,RASUB,RAREC,RAINSTR
+2 IF '$DATA(RATEXT)
SET RATEXT(8)="*** No referred orders found! ***"
+3 ;Mail message introductory blurb...
+4 SET RATEXT(1)="The Post-Init task for RA*5.0*196 searched for radiology"
+5 SET RATEXT(2)="orders in a complete, discontinued or held status that"
+6 SET RATEXT(3)="have previously been referred to community care using"
+7 SET RATEXT(4)="the Refer Selected Requests to COMMUNITY CARE Provider"
+8 SET RATEXT(5)="option. Orders previously referred using this option"
+9 SET RATEXT(6)="had the new Referred to Community Care? field set to YES."
+10 SET RATEXT(7)=""
SET RATEXT(11)=""
+11 ;XMTEXT for message text
+12 ;S XMTEXT="RATEXT("
+13 SET RASUB="RAD/NUC MED RA*5.0*196 Post-Install Information"
+14 SET RAID=+$GET(DUZ)
+15 ;send to installer
SET RAREC(RAID)=""
+16 SET RAINSTR("FROM")="RA*5.0*196 Post-Install"
+17 DO SENDMSG^XMXAPI(RAID,RASUB,"RATEXT",.RAREC,.RAINSTR,,)
+18 QUIT
