RA127PO ;BPFO/CLT - PATCH RA*5.0*127 POST INSTALL ; 23 Sep 2016 3:33 PM
;;5.0;Radiology/Nuclear Medicine;**127**;Mar 16, 1998;Build 119
;
; This routine uses the following IAs:
; #4640 - ^HDISVF01 calls (supported)
; #4639 - ^HDISVCMR calls (supported)
; #4651 - ^HDISVF09 calls (supported)
;
EN ;MAIN ENTRY POINT
N RAFAC,X,Y,DA,X1,X2,ZTRTN,ZTDESC,ZTDTH,TMP,DOMPTR,DIE,DA,DR,RADNTRT
S RAFAC=$$KSP^XUPARAM("INST")
S DIC="^RAMRPF(71.98,",DIC(0)="L",X=RAFAC D ^DIC S DA=+Y
S $P(^RAMRPF(71.98,1,0),U,6)="M",$P(^RAMRPF(71.98,1,0),U,1)=RAFAC,^RAMRPF(71.98,"B",RAFAC,1)=""
S RADNTRT="RADNTRT",DA=1
;S DIE="^RAMRPF(71.98,",DIE(0)="",DR="6///RADNTRT;11///"_"//vaauscttweb80.aac.domain.ext;11.5///isaac-rest/rest/1/request/termRequest;10///8080" D ^DIE
;S DIE="^RAMRPF(71.98,",DIE(0)="",DR="6///RADNTRT;11///isaac-rest/rest/1/request/termRequest;11.5///vaauscttweb80.aac.domain.ext;10///8080"
S DIE="^RAMRPF(71.98,",DIE(0)="",DR="6///RADNTRT;11///vaauscttweb80.aac.domain.ext;11.5///isaac-rest/rest/1/request/termRequest;10///8080"
S DR=DR_";11.6///MASTER-NTRT-RECEIVE_1.XSD" D ^DIE
;
TIMBUL ;QUEUE THE TIME BULLETIN
S ZTRTN="RATIMBUL",ZTDESC="Radiology new procedure time bulletin"
S X1=DT,X2=1 D C^%DTC S ZTDTH=X_.0300
D ^%ZTLOAD
;
;
HDIS ; do HDIS 'seeding'
N DOMPTR,TMP,DOMAIN,FIL,HDIMSG,A,B,C
; first check if 71.99 file has a .01 field
S A=0,A=$O(^RAMRPF(71.99,A)) I 'A D ;<
. N INS,DIC,DA,XUMF,NITM
. D INISEED
;
; check if process has already been done
S DOMAIN="RADIOLOGY",FIL=71.99
S A=$P($$GETSTAT^HDISVF01(FIL),U) I A S MSG="File: "_FIL_" Has already been seeded. Status is: "_A D PSTHALT(MSG) Q
;
S TMP=$$GETIEN^HDISVF09(DOMAIN,.DOMPTR)
I '+DOMPTR D MES^XPDUTL("***** Error retrieving the IEN for the "_DOMAIN_" domain."),PSTHALT("") Q
D EN^HDISVCMR(DOMPTR,FIL)
Q
;
PSTHALT(MSG) ; display error message
S HDIMSG(1)=""
S HDIMSG(2)=MSG
S HDIMSG(3)="***** Post-installation of Patch RA*5.0*127 HDIS 'seeding' has been halted."
S HDIMSG(4)="***** Please contact Enterprise VistA Support."
S HDIMSG(5)=""
D MES^XPDUTL(.HDIMSG)
Q
;
;
INISEED ; set initial items into ^RAMRPF(71.99
N INS,DIC,DA,XUMF,NITM
S INS="SPECT flow W RNC IV Liver+Spleen^US Guidance for Thoracentesis^US RUQ^US Spleen^US Aorta^Angio Adrenal Unilat^MRI Kidney(s) WO Contr^MRI Abd WO+W contr IV^XR Knee(s) Tunnel View"
F NITM=1:1:9 S X=$P(INS,U,NITM) S DIC="^RAMRPF(71.99,",DIC(0)="F",XUMF=1 D FILE^DICN
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRA127PO 2490 printed Oct 16, 2024@18:33:42 Page 2
RA127PO ;BPFO/CLT - PATCH RA*5.0*127 POST INSTALL ; 23 Sep 2016 3:33 PM
+1 ;;5.0;Radiology/Nuclear Medicine;**127**;Mar 16, 1998;Build 119
+2 ;
+3 ; This routine uses the following IAs:
+4 ; #4640 - ^HDISVF01 calls (supported)
+5 ; #4639 - ^HDISVCMR calls (supported)
+6 ; #4651 - ^HDISVF09 calls (supported)
+7 ;
EN ;MAIN ENTRY POINT
+1 NEW RAFAC,X,Y,DA,X1,X2,ZTRTN,ZTDESC,ZTDTH,TMP,DOMPTR,DIE,DA,DR,RADNTRT
+2 SET RAFAC=$$KSP^XUPARAM("INST")
+3 SET DIC="^RAMRPF(71.98,"
SET DIC(0)="L"
SET X=RAFAC
DO ^DIC
SET DA=+Y
+4 SET $PIECE(^RAMRPF(71.98,1,0),U,6)="M"
SET $PIECE(^RAMRPF(71.98,1,0),U,1)=RAFAC
SET ^RAMRPF(71.98,"B",RAFAC,1)=""
+5 SET RADNTRT="RADNTRT"
SET DA=1
+6 ;S DIE="^RAMRPF(71.98,",DIE(0)="",DR="6///RADNTRT;11///"_"//vaauscttweb80.aac.domain.ext;11.5///isaac-rest/rest/1/request/termRequest;10///8080" D ^DIE
+7 ;S DIE="^RAMRPF(71.98,",DIE(0)="",DR="6///RADNTRT;11///isaac-rest/rest/1/request/termRequest;11.5///vaauscttweb80.aac.domain.ext;10///8080"
+8 SET DIE="^RAMRPF(71.98,"
SET DIE(0)=""
SET DR="6///RADNTRT;11///vaauscttweb80.aac.domain.ext;11.5///isaac-rest/rest/1/request/termRequest;10///8080"
+9 SET DR=DR_";11.6///MASTER-NTRT-RECEIVE_1.XSD"
DO ^DIE
+10 ;
TIMBUL ;QUEUE THE TIME BULLETIN
+1 SET ZTRTN="RATIMBUL"
SET ZTDESC="Radiology new procedure time bulletin"
+2 SET X1=DT
SET X2=1
DO C^%DTC
SET ZTDTH=X_.0300
+3 DO ^%ZTLOAD
+4 ;
+5 ;
HDIS ; do HDIS 'seeding'
+1 NEW DOMPTR,TMP,DOMAIN,FIL,HDIMSG,A,B,C
+2 ; first check if 71.99 file has a .01 field
+3 ;<
SET A=0
SET A=$ORDER(^RAMRPF(71.99,A))
IF 'A
Begin DoDot:1
+4 NEW INS,DIC,DA,XUMF,NITM
+5 DO INISEED
End DoDot:1
+6 ;
+7 ; check if process has already been done
+8 SET DOMAIN="RADIOLOGY"
SET FIL=71.99
+9 SET A=$PIECE($$GETSTAT^HDISVF01(FIL),U)
IF A
SET MSG="File: "_FIL_" Has already been seeded. Status is: "_A
DO PSTHALT(MSG)
QUIT
+10 ;
+11 SET TMP=$$GETIEN^HDISVF09(DOMAIN,.DOMPTR)
+12 IF '+DOMPTR
DO MES^XPDUTL("***** Error retrieving the IEN for the "_DOMAIN_" domain.")
DO PSTHALT("")
QUIT
+13 DO EN^HDISVCMR(DOMPTR,FIL)
+14 QUIT
+15 ;
PSTHALT(MSG) ; display error message
+1 SET HDIMSG(1)=""
+2 SET HDIMSG(2)=MSG
+3 SET HDIMSG(3)="***** Post-installation of Patch RA*5.0*127 HDIS 'seeding' has been halted."
+4 SET HDIMSG(4)="***** Please contact Enterprise VistA Support."
+5 SET HDIMSG(5)=""
+6 DO MES^XPDUTL(.HDIMSG)
+7 QUIT
+8 ;
+9 ;
INISEED ; set initial items into ^RAMRPF(71.99
+1 NEW INS,DIC,DA,XUMF,NITM
+2 SET INS="SPECT flow W RNC IV Liver+Spleen^US Guidance for Thoracentesis^US RUQ^US Spleen^US Aorta^Angio Adrenal Unilat^MRI Kidney(s) WO Contr^MRI Abd WO+W contr IV^XR Knee(s) Tunnel View"
+3 FOR NITM=1:1:9
SET X=$PIECE(INS,U,NITM)
SET DIC="^RAMRPF(71.99,"
SET DIC(0)="F"
SET XUMF=1
DO FILE^DICN
+4 QUIT
