source: WorldVistAEHR/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAMAIN3.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.3 KB
RevLine 
[613]1RAMAIN3 ;HISC/PW - UPDATE CPRS ORDERABLE ITEMS ;7/24/02 14:45
2 ;;5.0;Radiology/Nuclear Medicine;**50**;Mar 16, 1998
3 ;called by RAMAIN
4ORDITMS ;*50 |=> The message has been changed - task off a job to update
5 ; the Orderable Items file 101.43
6 Q:'$$ORQUIK^RAORDU()
7 S RAMSG=DA N DA
8 S ZTRTN="QORDITMS^RAMAIN3",ZTDESC="RA MESSAGE UPDATE:ORDERABLE ITEMS"
9 N XX F XX="RAMLNB","RAMSG" S ZTSAVE(XX)=""
10 S ZTDTH=DT,ZTIO=""
11 D ^%ZTLOAD
12 ;D QORDITMS^RAMAIN3
13 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)," .",!
14 Q
15QORDITMS ; loop procedures to locate message and then send to CPRS
16 ;queued from RAMAIN w RAMSG,RAMLNB
17 S ZTREQ="@"
18 N RADA,RAINADT,RASTAT,RAFILE,RAY,RAENALL
19 S RADA=0 F S RADA=$O(^RAMIS(71,RADA)) Q:RADA'>0 D
20 . Q:'$D(^RAMIS(71,RADA,3,"B",RAMSG))
21 . S RAINADT=+$G(^RAMIS(71,RADA,"I"))
22 . I $L(RAMLNB),RAINADT,RAINADT<DT Q ;procedure will update CPRS when activated
23 . I '$L(RAMLNB) D DELMESG
24 . S RASTAT="1^1",RAENALL=0,RAY=RADA,RAFILE=71
25 . D PROC^RAO7MFN(RAENALL,RAFILE,RASTAT,RAY) ;as found in RAMAIN2
26 Q
27DELMESG ;Message was deleted from 71.4, need to delete from 71
28 N DA K DIK
29 S DA=$O(^RAMIS(71,RADA,3,"B",RAMSG,0)),DA(1)=RADA,DIK="^RAMIS(71,"_DA(1)_",3,"
30 D ^DIK
31 K DIK
32 Q
Note: See TracBrowser for help on using the repository browser.