RAMAIN3 ;HISC/PW - UPDATE CPRS ORDERABLE ITEMS ;7/24/02 14:45
;;5.0;Radiology/Nuclear Medicine;**50**;Mar 16, 1998
;called by RAMAIN
ORDITMS ;*50 |=> The message has been changed - task off a job to update
; the Orderable Items file 101.43
Q:'$$ORQUIK^RAORDU()
S RAMSG=DA N DA
S ZTRTN="QORDITMS^RAMAIN3",ZTDESC="RA MESSAGE UPDATE:ORDERABLE ITEMS"
N XX F XX="RAMLNB","RAMSG" S ZTSAVE(XX)=""
S ZTDTH=DT,ZTIO=""
D ^%ZTLOAD
;D QORDITMS^RAMAIN3
W !!,"Since the PROCEDURE MESSAGE TEXT has been changed, all CPRS Orderable",!,"Items that have this TEXT will be updated by task job ",$G(ZTSK)," .",!
Q
QORDITMS ; loop procedures to locate message and then send to CPRS
;queued from RAMAIN w RAMSG,RAMLNB
S ZTREQ="@"
N RADA,RAINADT,RASTAT,RAFILE,RAY,RAENALL
S RADA=0 F S RADA=$O(^RAMIS(71,RADA)) Q:RADA'>0 D
. Q:'$D(^RAMIS(71,RADA,3,"B",RAMSG))
. S RAINADT=+$G(^RAMIS(71,RADA,"I"))
. I $L(RAMLNB),RAINADT,RAINADT<DT Q ;procedure will update CPRS when activated
. I '$L(RAMLNB) D DELMESG
. S RASTAT="1^1",RAENALL=0,RAY=RADA,RAFILE=71
. D PROC^RAO7MFN(RAENALL,RAFILE,RASTAT,RAY) ;as found in RAMAIN2
Q
DELMESG ;Message was deleted from 71.4, need to delete from 71
N DA K DIK
S DA=$O(^RAMIS(71,RADA,3,"B",RAMSG,0)),DA(1)=RADA,DIK="^RAMIS(71,"_DA(1)_",3,"
D ^DIK
K DIK
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAMAIN3 1323 printed Sep 23, 2025@20:13:20 Page 2
RAMAIN3 ;HISC/PW - UPDATE CPRS ORDERABLE ITEMS ;7/24/02 14:45
+1 ;;5.0;Radiology/Nuclear Medicine;**50**;Mar 16, 1998
+2 ;called by RAMAIN
ORDITMS ;*50 |=> The message has been changed - task off a job to update
+1 ; the Orderable Items file 101.43
+2 if '$$ORQUIK^RAORDU()
QUIT
+3 SET RAMSG=DA
NEW DA
+4 SET ZTRTN="QORDITMS^RAMAIN3"
SET ZTDESC="RA MESSAGE UPDATE:ORDERABLE ITEMS"
+5 NEW XX
FOR XX="RAMLNB","RAMSG"
SET ZTSAVE(XX)=""
+6 SET ZTDTH=DT
SET ZTIO=""
+7 DO ^%ZTLOAD
+8 ;D QORDITMS^RAMAIN3
+9 WRITE !!,"Since the PROCEDURE MESSAGE TEXT has been changed, all CPRS Orderable",!,"Items that have this TEXT will be updated by task job ",$GET(ZTSK)," .",!
+10 QUIT
QORDITMS ; loop procedures to locate message and then send to CPRS
+1 ;queued from RAMAIN w RAMSG,RAMLNB
+2 SET ZTREQ="@"
+3 NEW RADA,RAINADT,RASTAT,RAFILE,RAY,RAENALL
+4 SET RADA=0
FOR
SET RADA=$ORDER(^RAMIS(71,RADA))
if RADA'>0
QUIT
Begin DoDot:1
+5 if '$DATA(^RAMIS(71,RADA,3,"B",RAMSG))
QUIT
+6 SET RAINADT=+$GET(^RAMIS(71,RADA,"I"))
+7 ;procedure will update CPRS when activated
IF $LENGTH(RAMLNB)
IF RAINADT
IF RAINADT<DT
QUIT
+8 IF '$LENGTH(RAMLNB)
DO DELMESG
+9 SET RASTAT="1^1"
SET RAENALL=0
SET RAY=RADA
SET RAFILE=71
+10 ;as found in RAMAIN2
DO PROC^RAO7MFN(RAENALL,RAFILE,RASTAT,RAY)
End DoDot:1
+11 QUIT
DELMESG ;Message was deleted from 71.4, need to delete from 71
+1 NEW DA
KILL DIK
+2 SET DA=$ORDER(^RAMIS(71,RADA,3,"B",RAMSG,0))
SET DA(1)=RADA
SET DIK="^RAMIS(71,"_DA(1)_",3,"
+3 DO ^DIK
+4 KILL DIK
+5 QUIT
