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

PXRMEXFI.m

Go to the documentation of this file.
  1. PXRMEXFI ;SLC/PKR/PJH - Exchange utilities for file entries. ;10/21/2019
  1. ;;2.0;CLINICAL REMINDERS;**6,12,18,24,26,47,45**;Feb 04, 2005;Build 566
  1. ;==============================================
  1. DELALL(FILENUM,NAME) ;Delete all file entries named NAME.
  1. N IEN,IND,LIST,MSG
  1. D FIND^DIC(FILENUM,"","@","MU",NAME,"*","","","","LIST","MSG")
  1. I $P(LIST("DILIST",0),U,1)=0 Q
  1. S IND=0
  1. F S IND=$O(LIST("DILIST",2,IND)) Q:IND="" D
  1. . S IEN=LIST("DILIST",2,IND)
  1. . D DELETE(FILENUM,IEN)
  1. Q
  1. ;
  1. ;==============================================
  1. DELETE(FILENUM,DA) ;Delete a file entry.
  1. N DIK
  1. S DIK=$$ROOT^DILFD(FILENUM)
  1. D ^DIK
  1. Q
  1. ;
  1. ;==============================================
  1. FEIMSG(SAME,ATTR) ;Output the general file exists install message.
  1. N IND,NOUT,TEXT,TEXTO
  1. S TEXT(1)=ATTR("FILE NAME")_" entry named "_ATTR("NAME")_" already exists"
  1. I SAME D
  1. . W "."
  1. I 'SAME D
  1. . S TEXT(2)="but the packed component is different, what do you want to do?"
  1. . D FORMAT^PXRMTEXT(1,70,2,.TEXT,.NOUT,.TEXTO)
  1. . F IND=1:1:NOUT W !,TEXTO(IND)
  1. Q
  1. ;
  1. ;==============================================
  1. FOKTT(FILENUM) ;Check if it is ok to transport items from this file.
  1. ;
  1. ;Drugs not allowed.
  1. I FILENUM=50 Q 0
  1. ;
  1. ;VA Generic not allowed.
  1. I FILENUM=50.6 Q 0
  1. ;
  1. ;VA Drug Class not allowed.
  1. I FILENUM=50.605 Q 0
  1. ;
  1. ;VA Product not allowed.
  1. I FILENUM=50.68 Q 0
  1. ;
  1. ;Lab tests not allowed.
  1. I FILENUM=60 Q 0
  1. ;
  1. ;Radiology procedures not allowed.
  1. I FILENUM=71 Q 0
  1. ;
  1. ;Imaging type not allowed.
  1. ;I FILENUM=79.2 Q 0
  1. ;
  1. ;ICD9 (used in Dialogs) not allowed.
  1. I FILENUM=80 Q 0
  1. ;
  1. ;ICD0 not allowed.
  1. I FILENUM=80.1 Q 0
  1. ;
  1. ;CPT (used in Dialogs) not allowed.
  1. I FILENUM=81 Q 0
  1. ;
  1. ;Order Dialogs not allowed.
  1. I FILENUM=101.41 Q 0
  1. ;
  1. ;Orderable Items not allowed.
  1. I FILENUM=101.43 Q 0
  1. ;
  1. ;GMRV VITAL TYPE not allowed.
  1. I FILENUM=120.51 Q 0
  1. ;
  1. ;Health Summary Type allowed in certain cases.
  1. I FILENUM=142 Q 1
  1. ;
  1. ;Health Summary Components allowed in certain cases.
  1. I FILENUM=142.1 Q 1
  1. ;
  1. ;Health Summary Object allowed in certain cases.
  1. I FILENUM=142.5 Q 1
  1. ;
  1. ;Mental Health Instruments not allowed.
  1. I FILENUM=601 Q 0
  1. I FILENUM=601.71 Q 0
  1. ;
  1. ;WV Notification Purpose not allowed.
  1. I FILENUM=790.404 Q 0
  1. ;
  1. ;TIU Document Definition allowed in certain cases.
  1. I FILENUM=8925.1 Q 1
  1. ;
  1. ;Immunizations not allowed.
  1. I FILENUM=9999999.14 Q 0
  1. ;
  1. ;Imaging type
  1. I FILENUM=79.2 Q 0
  1. ;
  1. ;Reminder Function Finding
  1. I FILENUM=801.47 Q 0
  1. ;
  1. ;Make sure the file exists.
  1. I $$ROOT^DILFD(FILENUM)="" Q 0
  1. ;
  1. I $G(PXRMIGDS) Q 1
  1. ;If a file has been standardized do not transport it.
  1. ;DBIA #4640
  1. I $P($$GETSTAT^HDISVF01(FILENUM),U,1)>0 Q 0
  1. ;If control gets to here then it is an allowed file type.
  1. ;
  1. Q 1
  1. ;
  1. ;==============================================
  1. GETFACT(PT01,ATTR,NEWPT01,NAMECHG,IEN) ;Get the action for a file.
  1. N ACTION,CHOICES,CSUM,DIR,FILENUM,MSG,RESULT
  1. N SAME,X,Y
  1. ;See if this entry is already defined.
  1. CHK ;
  1. S NEWPT01=""
  1. S FILENUM=ATTR("FILE NUMBER")
  1. I IEN="" S IEN=$$EXISTS^PXRMEXIU(FILENUM,PT01)
  1. I IEN D
  1. .;If the entry already exists compare the existing entry checksum
  1. .;with the packed entry checksum.
  1. . S CSUM=$$FILE^PXRMEXCS(ATTR("FILE NUMBER"),IEN)
  1. . S SAME=$S(ATTR("CHECKSUM")=CSUM:1,1:0)
  1. . D FEIMSG(SAME,.ATTR)
  1. . I SAME S ACTION="S"
  1. . I 'SAME D
  1. .. S CHOICES=$S(FILENUM=801.41:"CMOUQS",FILENUM=811.5:"CMOUQS",1:"COUQS")
  1. .. S DIR("B")="O"
  1. .. S ACTION=$$GETACT^PXRMEXIU(CHOICES,.DIR)
  1. E D
  1. . W !!,ATTR("FILE NAME")," entry ",PT01," is NEW,"
  1. . W !,"what do you want to do?"
  1. . S CHOICES="CIQS"
  1. . S DIR("B")="I"
  1. . S ACTION=$$GETACT^PXRMEXIU(CHOICES,.DIR)
  1. ;
  1. I ACTION="Q" Q ACTION
  1. I ACTION="C" D
  1. . S NEWPT01=$$GETUNAME^PXRMEXIU(.ATTR)
  1. .;Make sure the NEW .01 passes any input transforms.
  1. . I NEWPT01="" S ACTION="S"
  1. . E D CHK^DIE(ATTR("FILE NUMBER"),.01,"",NEWPT01,.RESULT,"MSG")
  1. I $G(RESULT)="^" D G CHK
  1. . D AWRITE^PXRMUTIL("MSG")
  1. . K RESULT
  1. ;
  1. I ACTION="O" D
  1. .;If the action is overwrite double check that is what the user
  1. .;really wants to do.
  1. . N DIROUT,DIRUT,DTOUT,DUOUT
  1. . K DIR
  1. . S DIR(0)="Y"_U_"A"
  1. . S DIR("A")="Are you sure you want to overwrite"
  1. . S DIR("B")="N"
  1. . D ^DIR
  1. . I $D(DIROUT)!$D(DIRUT) S Y=0
  1. . I $D(DTOUT)!$D(DUOUT) S Y=0
  1. . S ACTION=$S(Y:"O",1:"S")
  1. ;
  1. I ACTION="P" D
  1. . N DIC,Y
  1. . S DIC=ATTR("FILE NUMBER")
  1. . S DIC(0)="AEMQ"
  1. . D ^DIC
  1. . I Y=-1 S ACTION="S"
  1. . E S NEWPT01=$P(Y,U,2)
  1. ;
  1. I NEWPT01'="" S NAMECHG(ATTR("FILE NUMBER"),PT01)=NEWPT01
  1. Q ACTION
  1. ;
  1. ;==============================================
  1. IOKTI(IEN,FILENUM,ITEMINFO) ;Check if it is ok to install this item.
  1. ;To be installable, items from 801.41 need to be marked as selectable.
  1. I FILENUM=801.41 Q $P(ITEMINFO,U,7)
  1. ;Do not allow national routines.
  1. I (FILENUM=0),'$D(PXRMINCF),$E($P(ITEMINFO,U,1),1,4)="PXRM" Q 0
  1. N FDASTART,FDAEND
  1. S FDASTART=$P(ITEMINFO,U,2)
  1. S FDAEND=$P(ITEMINFO,U,3)
  1. ;If FDSTART=FDAEND then only the .01 was packed so it may not
  1. ;be installable.
  1. I FDASTART=FDAEND Q $$IOKTP(FILENUM)
  1. ;Check computed findings, national ones cannot be installed.
  1. I (FILENUM=811.4),'$D(PXRMINCF) Q $$CFOKTI^PXRMEXU0(IEN,FDASTART,FDAEND)
  1. Q 1
  1. ;
  1. ;==============================================
  1. IOKTP(FILENUM,IEN) ;Check if it is ok to pack this item.
  1. ;If the entire file is not transportable we are done
  1. I '$$FOKTT(FILENUM) Q 0
  1. N OK
  1. S OK=1
  1. ;Check files where only specific entries can be packed.
  1. ;
  1. ;Health Summary Object not allowed if the type is not allowed
  1. I FILENUM=142.5 D Q OK
  1. . I '$D(IEN)!($G(IEN)="") S OK=0 Q
  1. . N HSTIEN
  1. . S HSTIEN=$P($G(^GMT(142.5,IEN,0)),U,3) I HSTIEN'>0 S OK=0 Q
  1. . S OK=$$IOKTP(142,HSTIEN)
  1. .;DBIA #5445
  1. . I OK=0 D EN^GMTSDESC(IEN,142.5,"HS OBJECT")
  1. ;
  1. ;Health Summary Type not allowed if it contains local components
  1. ;or PROGRESS NOTE SELECTED component
  1. I FILENUM=142 D Q OK
  1. . I +$G(IEN)=0 S OK=0 Q
  1. . N IND,PGSIEN
  1. . S PGSIEN=$O(^GMT(142.1,"B","PROGRESS NOTES SELECTED",""))
  1. . S IND=0,OK=1
  1. . ;Scan HS Type for components, do not pack if it contains local
  1. . ;components or selected Progress Note Component.
  1. . F S IND=$O(^GMT(142,IEN,1,IND)) Q:('OK)!(IND="") D
  1. .. I $P($G(^GMT(142,IEN,1,IND,0)),U,2)>99999 S OK=0 Q
  1. .. I $P($G(^GMT(142,IEN,1,IND,0)),U,2)=PGSIEN S OK=0 Q
  1. .;DBIA #5445
  1. . I OK=0 D EN^GMTSDESC(IEN,142,"HS TYPE")
  1. ;
  1. ;Health Summary Components not allowed. National components do not
  1. ;need to be packed, they already exist.
  1. I FILENUM=142.1 D Q OK
  1. .;Only use to pack new national components being released
  1. .;with the patch.
  1. . I '$G(PXRMIHSC) S OK=0
  1. .;DBIA #5445
  1. .;Create description of local HS Components
  1. . I +$G(IEN)>99999 D EN^GMTSDESC(IEN,142.1,"HS COMP")
  1. ;
  1. ;TIU Document Definition, allowed only if it is a health summary object.
  1. I FILENUM=8925.1 D Q OK
  1. . N ARY,HSOIEN
  1. . I '$D(IEN)!($G(IEN)="") S OK=0 Q
  1. .;DBIA #5447
  1. . D OBJBYIEN^TIUCHECK(.ARY,IEN)
  1. . ;
  1. . ;If not TIU object and INST is set, assume this is called from a
  1. . ;national patch installing TIU Title and Document Class.
  1. . I ARY(IEN,.04)'="O",PXRMINST=1 S OK=1 Q
  1. . ;
  1. . ;Only allow TIU/HS Object to be installed.
  1. . I $G(ARY(IEN,9))'["S X=$$TIU^GMTSOBJ(" S OK=0 Q
  1. . S HSOIEN=+$P(ARY(IEN,9),",",2)
  1. . I HSOIEN'>0 S OK=0 Q
  1. . S OK=$$IOKTP(142.5,HSOIEN)
  1. . I OK=0 D TIU^PXRMEXU5(IEN,.ARY,"TIU OBJECT")
  1. ;
  1. Q OK
  1. ;
  1. ;==============================================
  1. NTHLOC(IEN,SUB) ;Save information about non-transportable hospital locations.
  1. N HLOC,IND,NL
  1. S NL=1,^TMP($J,SUB,IEN,NL)="Location List: "_$P(^PXRMD(810.9,IEN,0),U,1)
  1. S IND=0
  1. F S IND=+$O(^PXRMD(810.9,IEN,44,IND)) Q:IND=0 D
  1. . S NL=NL+1
  1. .;DBIA #10040
  1. . S HLOC=^PXRMD(810.9,IEN,44,IND,0),HLOC=$P(^SC(HLOC,0),U,1)
  1. . S ^TMP($J,SUB,IEN,NL)=" "_HLOC
  1. Q
  1. ;
  1. ;==============================================
  1. SETATTR(ATTR,FILE,PT01) ;Set the file attributes for the file FILE.
  1. N MSG
  1. S ATTR("FILE NUMBER")=FILE
  1. S ATTR("FILE NAME")=$$GET1^DID(FILE,"","","NAME","","MSG")
  1. ;This call gets the field length.
  1. D FIELD^DID(FILE,.01,"","FIELD LENGTH","ATTR","MSG")
  1. S ATTR("MIN FIELD LENGTH")=3
  1. S (ATTR("NAME"),ATTR("PT01"))=PT01
  1. Q
  1. ;