RA50PST.m

RA50PST ;HISC/PW - UPDATE CPRS ORDERABLE ITEMS ;7/24/02  14:45

 ;;5.0;Radiology/Nuclear Medicine;**50**;Mar 16, 1998

QUEUE ;

 I '$$ORQUIK^RAORDU() D BMES^XPDUTL("Postinit will not run, No CPRS Order Dialogue file 101.4") Q

 S ZTDESC="RA*5*50 - postinit to update Orderable Items file (#101.43) from RAD/NUC MED PROCEDURES FILE (#71)"

 S ZTRTN="DEQUE^RA50PST",ZTIO=""

 S ZTDTH=$G(XPDQUES("POS001 POSTINIT TIME")) S:+ZTDTH=0 ZTDTH=DT

 D ^%ZTLOAD

 S RAMSG=$S($G(ZTSK):"The job is scheduled by task "_ZTSK,1:"The job has not been queued")

 D BMES^XPDUTL(RAMSG)

 I $G(ZTSK) D BMES^XPDUTL("Scheduled for "_XPDQUES("POS001 POSTINIT TIME","B"))

 Q 

DEQUE ; loop procedures to locate message and then send to CPRS

 S ZTREQ="@"

 N RADA,RAINADT,RASTAT,RAFILE,RAY,RAENALL

 K ^TMP($J)

 S RADA=0,CNT=0 F  S RADA=$O(^RAMIS(71,RADA)) Q:RADA'>0  D

 . Q:'$D(^RAMIS(71,RADA,3,"B"))

 . S RAINADT=+$G(^RAMIS(71,RADA,"I"))

 . I RAINADT,RAINADT<DT Q  ;procedure will update CPRS when activated

 . S RASTAT="1^1",RAENALL=0,RAY=RADA,RAFILE=71,CNT=CNT+1

 . D PROC^RAO7MFN(RAENALL,RAFILE,RASTAT,RAY) ;as found in RAMAIN2

 . S ^TMP($J,CNT+6)=$J(RADA,8)_"   "_$$GET1^DIQ(71,RADA,.01)

 S ^TMP($J,1)="RA*5*50 Postinit - Procedure Update of Orderable Item file Report"

 S ^TMP($J,2)=" "

 S ^TMP($J,2)="    Please forward this email to the Radiology ADPAC."

 S ^TMP($J,4)="    RAD/NUC MED PROCEDURE file (# 71)"

 S ^TMP($J,5)="# 71 IEN   RA Procedure/Orderable Item         Total Updated = "_CNT

 S ^TMP($J,6)=" "

 S XMSUB="RA*5*50 Postinit - Procedure Update of Orderable Item file Report"

 S XMTEXT="^TMP($J,"

 S XMY(DUZ)="",XMDUZ="RA*5*50 POSTINIT"

 D ^XMD

 K ^TMP($J)

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---RA50PST   1677     printed  Apr 09, 2024@21:35:07                                                                                                                                                                                                     Page 2

RA50PST   ;HISC/PW - UPDATE CPRS ORDERABLE ITEMS ;7/24/02  14:45

 +1       ;;5.0;Radiology/Nuclear Medicine;**50**;Mar 16, 1998

QUEUE     ;

 +1        IF '$$ORQUIK^RAORDU()

               DO BMES^XPDUTL("Postinit will not run, No CPRS Order Dialogue file 101.4")

               QUIT 

 +2        SET ZTDESC="RA*5*50 - postinit to update Orderable Items file (#101.43) from RAD/NUC MED PROCEDURES FILE (#71)"

 +3        SET ZTRTN="DEQUE^RA50PST"

           SET ZTIO=""

 +4        SET ZTDTH=$GET(XPDQUES("POS001 POSTINIT TIME"))

           if +ZTDTH=0

               SET ZTDTH=DT

 +5        DO ^%ZTLOAD

 +6        SET RAMSG=$SELECT($GET(ZTSK):"The job is scheduled by task "_ZTSK,1:"The job has not been queued")

 +7        DO BMES^XPDUTL(RAMSG)

 +8        IF $GET(ZTSK)

               DO BMES^XPDUTL("Scheduled for "_XPDQUES("POS001 POSTINIT TIME","B"))

 +9        QUIT 

DEQUE     ; loop procedures to locate message and then send to CPRS

 +1        SET ZTREQ="@"

 +2        NEW RADA,RAINADT,RASTAT,RAFILE,RAY,RAENALL

 +3        KILL ^TMP($JOB)

 +4        SET RADA=0

           SET CNT=0

           FOR 

               SET RADA=$ORDER(^RAMIS(71,RADA))

               if RADA'>0

                   QUIT 

               Begin DoDot:1

 +5                if '$DATA(^RAMIS(71,RADA,3,"B"))

                       QUIT 

 +6                SET RAINADT=+$GET(^RAMIS(71,RADA,"I"))

 +7       ;procedure will update CPRS when activated

                   IF RAINADT

                       IF RAINADT<DT

                           QUIT 

 +8                SET RASTAT="1^1"

                   SET RAENALL=0

                   SET RAY=RADA

                   SET RAFILE=71

                   SET CNT=CNT+1

 +9       ;as found in RAMAIN2

                   DO PROC^RAO7MFN(RAENALL,RAFILE,RASTAT,RAY)

 +10               SET ^TMP($JOB,CNT+6)=$JUSTIFY(RADA,8)_"   "_$$GET1^DIQ(71,RADA,.01)

               End DoDot:1

 +11       SET ^TMP($JOB,1)="RA*5*50 Postinit - Procedure Update of Orderable Item file Report"

 +12       SET ^TMP($JOB,2)=" "

 +13       SET ^TMP($JOB,2)="    Please forward this email to the Radiology ADPAC."

 +14       SET ^TMP($JOB,4)="    RAD/NUC MED PROCEDURE file (# 71)"

 +15       SET ^TMP($JOB,5)="# 71 IEN   RA Procedure/Orderable Item         Total Updated = "_CNT

 +16       SET ^TMP($JOB,6)=" "

 +17       SET XMSUB="RA*5*50 Postinit - Procedure Update of Orderable Item file Report"

 +18       SET XMTEXT="^TMP($J,"

 +19       SET XMY(DUZ)=""

           SET XMDUZ="RA*5*50 POSTINIT"

 +20       DO ^XMD

 +21       KILL ^TMP($JOB)

 +22       QUIT