RAMAIN3.m

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

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