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

RA97PST.m

Go to the documentation of this file. 
  1. RA97PST ;;HINES/RVD Post-init for BI-RADS and File 79.4 ; 10/10/08
  1.  ;;5.0;Radiology/Nuclear Medicine;**97**;Mar 16, 1998;Build 6
  1.  ; This is the post-install routine for patch RA*5.0*97
  1.  ;
  1.  ; Supported IA's
  1.  ;    BMES^XPDUTL  =   10141
  1.  ;    KSP^XUPARAM  =   2541
  1.  ;    UPDATE^DIE   =   2053
  1.  ;    GET1^DIQ     =   2056
  1.  ;    ^XMD         =   10070
  1.  ;
  1.  ; Private IA's
  1.  ;    Set Identifier "WRITE" node          =  5418
  1.  ;    Insert "I" in ^RA(78.3,0), piece 2   =  5419
  1.  ;
  1.  ;1. Add records to file 78.3
  1.  ; If there are no IENs 1100 thru 1106 and 1200 thru 1202
  1.  ; then this routine will add records to file #78.3 using
  1.  ; these IENs and set the 3rd piece of ^RA(78.3,0) to the
  1.  ; highest IEN under IEN 999.
  1.  ;
  1.  ;2. Set the Identifier "WRITE" node for file 78.3's field 6
  1.  ;
  1.  ;3. Insert "I" into ^RA(78.3,0), piece 2, after file number
  1.  Q
  1. CRE ;create BI-RADS entry in file 78.3
  1.  I '$D(DUZ)#2 D BMES^XPDUTL("*** Missing DUZ.  Post-init not done. ***") Q
  1.  N RAIEN,RALEX,RAERR,RA,RAI,RAFLG,RAFDA,RAFAC,RANXT,RAD,RAPA,RAPAPG
  1.  N RA1,RA2,RA3,RAAA,RACT,RATXT,RAX
  1.  D BMES^XPDUTL("*** ADDING BI-RADS to file #78.3.")
  1.  D BIR^RA97PST1("MAMMOGRAM",.RA,"","BIR","MQSA","MAMMOGRAPHY ASSESSMENT CATEGORIES")
  1.  ;check to see if the facility has records within the 
  1.  ;1100 thru 1106 and 1200 thru 1202 IEN range within file #78.3,
  1.  ;the DIAGNOSTIC CODES file. 
  1.  ;If there are, proceed with the install any way
  1.  ;but:
  1.  ;1) DO NOT alter the data (change pointers) in the file at the facility
  1.  ;2) Send an email to an Outlook mail group identifying the facility 
  1.  ;   where the conflict occurs.
  1.  ;If there is no conflict, then add the IEN records to file 78.3
  1.  ;RAFLG=1 means a record already exist in file 78.3 for the 
  1.  ;range 1100 thru 1106 and 1200 thru 1202.
  1.  S RAFLG=0,RANXT=0
  1.  S RACT=0 ;counts number of successfully added records
  1.  ;
  1.  ;example:
  1.  ; check range 1100 thru 1106 and build RAD array
  1.  ;    ra(3)="84^Benign ^Category 2"  <-- in
  1.  ;rad(1102)="84^Benign ^CATEGORY 2"  <-- out
  1.  ;
  1.  F RAI=1100:1:1106 D  Q:RAFLG=1
  1.  .S RANXT=$O(RA(RANXT))
  1.  .I $D(^RA(78.3,RAI,0)) S RAFLG=1 Q
  1.  .S RAD(RAI)=RA(RANXT)
  1.  .S $P(RAD(RAI),U,3)=$$UP^XLFSTR($P(RAD(RAI),U,3))
  1.  .;remove trailing blank from piece 2
  1.  .S RAX=$P(RAD(RAI),U,2),RA2=$L(RAX)
  1.  .S:$E(RAX,RA2)=" " $P(RAD(RAI),U,2)=$E(RAX,1,RA2-1)
  1.  .Q
  1.  ; check range 1200 thru 1202
  1.  I 'RAFLG F RAI=1200:1:1202 D  Q:RAFLG=1
  1.  .I $D(^RA(78.3,RAI,0)) S RAFLG=1 Q
  1.  .Q
  1.  ;
  1.  ;if RAFLG=1 email Outlook mail group, skip to ID section
  1.  I RAFLG=1 D  G ID
  1.  .S RAFAC=$$GET1^DIQ(4,+$$KSP^XUPARAM("INST"),.01)
  1.  .N XMDUZ,XMSUB,XMTEXT,XMY,XMZ S XMDUZ=.5
  1.  .S RATXT(1)=RAFAC_" has a conflict with one or more IENS in file 78.3,"
  1.  .S RATXT(2)="DIAGNOSTIC CODES, in the range 1100-1106 and 1200-1202."
  1.  .S XMSUB="DIAGNOSTIC CODES file IEN issue @ "_RAFAC,XMTEXT="RATXT("
  1.  .S XMY(DUZ)=""  ;send Vista email of problem to the patch installer
  1.  .; Define Outlook mail group to receive email of problem
  1.  .S XMY("VAOITVHITRadiologyFacilityLevelApplicationIssues@domain.ext")=""
  1.  .NEW DIFROM
  1.  .D ^XMD,BMES^XPDUTL(.RATXT)
  1.  .Q
  1.  ;
  1.  ; Set up RAAA() for the Abdominal Aortic Aneurysm codes
  1.  ;raaa(IEN file 78.3)=field .01^field 2^fields 3 and 4
  1.  F RAI=1:1 S RAX=$T(AAACODE+RAI) Q:RAX=""  D
  1.  .S RAX=$P(RAX,";;",2) ;redefine RAX
  1.  .S RA1=$P(RAX,U,1),RA2=$P(RAX,U,2),RA3=$P(RAX,U,3)
  1.  .S:RA2=1 $P(RAAA(RA1),U,1)=RA3
  1.  .S:RA2=2 $P(RAAA(RA1),U,2)=RA3
  1.  .S:RA2=3 $P(RAAA(RA1),U,3)=RA3
  1.  .Q
  1.  ;
  1.  ;Add the BI-RADS codes to file 78.3
  1.  D
  1.  .S RAI=0 F  S RAI=$O(RAD(RAI)) Q:RAI=""  D
  1.  ..S RAPA=$P($P(RAD(RAI),U,3),"CATEGORY ",2)
  1.  ..;categories 0,3,4,5,6 have alerts
  1.  ..S RAPAPG="n" S:"^0^3^4^5^6^"[("^"_RAPA_"^") RAPAPG="y"
  1.  ..S RAFDA(78.3,"+1,",.01)="BI-RADS "_$P(RAD(RAI),U,3)
  1.  ..S RAFDA(78.3,"+1,",2)=$E($P(RAD(RAI),U,2),1,80)
  1.  ..S RAFDA(78.3,"+1,",3)=$$UP^XLFSTR(RAPAPG)
  1.  ..S RAFDA(78.3,"+1,",4)=RAPAPG
  1.  ..S RAFDA(78.3,"+1,",6)=$P(RAD(RAI),U,1)
  1.  ..S RAIEN(1)=RAI
  1.  ..D UPDATE^DIE("","RAFDA","RAIEN","RAERR")
  1.  ..I $D(RAERR)#2 D
  1.  ...S RATXT(1)="",RATXT(2)="Error adding "_$P(RAD(RAI),U,3)_" to the"
  1.  ...S RATXT(3)="local DIAGNOSTIC CODES file #78.3." D BMES^XPDUTL(.RATXT)
  1.  ..E  S RACT=RACT+1
  1.  ..K RAFDA,RAIEN,RAERR
  1.  ..Q
  1.  .Q
  1.  ;
  1.  ; Add the AAA codes to file 78.3
  1.  D
  1.  .S RA1=0 F  S RA1=$O(RAAA(RA1)) Q:RA1=""  D
  1.  ..S RAPAPG=$P(RAAA(RA1),U,3)
  1.  ..S RAFDA(78.3,"+1,",.01)=$P(RAAA(RA1),U,1)
  1.  ..S RAFDA(78.3,"+1,",2)=$P(RAAA(RA1),U,2)
  1.  ..S RAFDA(78.3,"+1,",3)=$$UP^XLFSTR(RAPAPG)
  1.  ..S RAFDA(78.3,"+1,",4)=RAPAPG
  1.  ..S RAIEN(1)=RA1
  1.  ..D UPDATE^DIE("","RAFDA","RAIEN","RAERR")
  1.  ..I $D(RAERR)#2 D
  1.  ...S RATXT(1)=""
  1.  ...S RATXT(2)="Error adding "_$P(RAAA(RA1),U,1)_" to the"
  1.  ...S RATXT(3)="local DIAGNOSTIC CODES file #78.3." D BMES^XPDUTL(.RATXT)
  1.  ..E  S RACT=RACT+1
  1.  ..K RAFDA,RAIEN,RAERR
  1.  K RATXT
  1.  S RATXT(1)=""
  1.  S RATXT(2)="*** "_RACT_" of 10 BI-RADS and Abdominal Aortic Aneurysm codes"
  1.  S RATXT(3)="have been successfully added to the DIAGNOSTIC CODES file #78.3. ***"
  1.  D BMES^XPDUTL(.RATXT)
  1.  ;put 3rd piece of ^RA(78.3,0) to highest value but under 999
  1.  S RA1=$O(^RA(78.3,999),-1)
  1.  S $P(^RA(78.3,0),U,3)=RA1
  1. ID ;set Identifier "WRITE" node and insert "I"
  1.  I '$D(^DD(78.3,0,"ID","WRITE")) D
  1.  .S ^DD(78.3,0,"ID","WRITE")="D EN^DDIOL($$EN1^RABIRAD,"""",""?33"")"
  1.  .D BMES^XPDUTL("*** Identifier ""WRITE"" has been added to file #78.3.")
  1.  ; set "I" after file number in ^RA(78.3,0)
  1.  S RA1=$P(^RA(78.3,0),U,2) I RA1=78.3 D
  1.  .S $P(^RA(78.3,0),U,2)=RA1_"I"
  1.  .D BMES^XPDUTL("*** ""I"" has been inserted to ^RA(78.3,0).")
  1.  Q
  1. AAACODE ; Abdominal Aortic Aneurysm codes
  1.  ;;1200^1^ABDOMINAL AORTIC ANEURYSM NOT PRESENT
  1.  ;;1200^2^The maximum width of the infrarenal aorta is less than three centimeters.
  1.  ;;1200^3^n
  1.  ;;1201^1^ABDOMINAL AORTIC ANEURYSM PRESENT
  1.  ;;1201^2^The maximum width of the infrarenal aorta is at least three centimeters.
  1.  ;;1201^3^y
  1.  ;;1202^1^DOES NOT SATISFY SCREEN FOR AAA
  1.  ;;1202^2^Exam is not technically adequate for AAA screening.
  1.  ;;1202^3^n