Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RA127PO

RA127PO.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1.  ; This routine uses the following IAs:
  1.  ; #4640 - ^HDISVF01 calls (supported)
  1.  ; #4639 - ^HDISVCMR calls     (supported)
  1.  ; #4651 - ^HDISVF09 calls     (supported)
  1.  ;
  1. EN ;MAIN ENTRY POINT
  1.  N RAFAC,X,Y,DA,X1,X2,ZTRTN,ZTDESC,ZTDTH,TMP,DOMPTR,DIE,DA,DR,RADNTRT
  1.  S RAFAC=$$KSP^XUPARAM("INST")
  1.  S DIC="^RAMRPF(71.98,",DIC(0)="L",X=RAFAC D ^DIC S DA=+Y
  1.  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)=""
  1.  S RADNTRT="RADNTRT",DA=1
  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
  1.  ;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"
  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"
  1.  S DR=DR_";11.6///MASTER-NTRT-RECEIVE_1.XSD" D ^DIE
  1.  ;
  1. TIMBUL ;QUEUE THE TIME BULLETIN
  1.  S ZTRTN="RATIMBUL",ZTDESC="Radiology new procedure time bulletin"
  1.  S X1=DT,X2=1 D C^%DTC S ZTDTH=X_.0300
  1.  D ^%ZTLOAD
  1.  ;
  1.  ;
  1. HDIS ; do HDIS 'seeding'
  1.  N DOMPTR,TMP,DOMAIN,FIL,HDIMSG,A,B,C
  1.  ; first check if 71.99 file has a .01 field
  1.  S A=0,A=$O(^RAMRPF(71.99,A)) I 'A D  ;<
  1.  . N INS,DIC,DA,XUMF,NITM
  1.  . D INISEED
  1.  ;
  1.  ; check if process has already been done
  1.  S DOMAIN="RADIOLOGY",FIL=71.99
  1.  S A=$P($$GETSTAT^HDISVF01(FIL),U) I A S MSG="File: "_FIL_" Has already been seeded. Status is: "_A D PSTHALT(MSG) Q
  1.  ;
  1.  S TMP=$$GETIEN^HDISVF09(DOMAIN,.DOMPTR)
  1.  I '+DOMPTR D MES^XPDUTL("***** Error retrieving the IEN for the "_DOMAIN_" domain."),PSTHALT("") Q
  1.  D EN^HDISVCMR(DOMPTR,FIL)
  1.  Q
  1.  ;
  1. PSTHALT(MSG) ; display error message
  1.  S HDIMSG(1)=""
  1.  S HDIMSG(2)=MSG
  1.  S HDIMSG(3)="***** Post-installation of Patch RA*5.0*127 HDIS 'seeding' has been halted."
  1.  S HDIMSG(4)="***** Please contact Enterprise VistA Support."
  1.  S HDIMSG(5)=""
  1.  D MES^XPDUTL(.HDIMSG)
  1.  Q
  1.  ;
  1.  ;
  1. INISEED ; set initial items into ^RAMRPF(71.99
  1.  N INS,DIC,DA,XUMF,NITM
  1.  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"
  1.  F NITM=1:1:9 S X=$P(INS,U,NITM) S DIC="^RAMRPF(71.99,",DIC(0)="F",XUMF=1 D FILE^DICN
  1.  Q