- 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 Feb 19, 2025@00:03:31 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