source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMEXFI.m@ 613

PXRMEXFI        ; SLC/PKR/PJH - Exchange utilities for file entries.;07/05/2007
        ;;2.0;CLINICAL REMINDERS;**6**;Feb 04, 2005;Build 123
        ;==============================================
DELALL(FILENUM,NAME)    ;Delete all file entries named NAME.
        N IEN,IND,LIST,MSG
        D FIND^DIC(FILENUM,"","@","K",NAME,"*","","","","LIST","MSG")
        I $P(LIST("DILIST",0),U,1)=0 Q
        S IND=0
        F  S IND=$O(LIST("DILIST",2,IND)) Q:IND=""  D
        . S IEN=LIST("DILIST",2,IND)
        . D DELETE(FILENUM,IEN)
        Q
        ;
        ;==============================================
DELETE(FILENUM,DA)      ;Delete a file entry.
        N DIK
        S DIK=$$ROOT^DILFD(FILENUM)
        D ^DIK
        Q
        ;
        ;==============================================
FEIMSG(SAME,ATTR)       ;Output the general file exits install message.
        N IND,NOUT,TEXT,TEXTO
        S TEXT(1)=ATTR("FILE NAME")_" entry named "_ATTR("NAME")_" already exists"
        I SAME D
        . S TEXT(2)="and the packed component is identical, skipping."
        . S TEXT(3)=" "
        . D FORMAT^PXRMTEXT(1,70,3,.TEXT,.NOUT,.TEXTO)
        . F IND=1:1:NOUT W !,TEXTO(IND)
        . H 2
        I 'SAME D
        . S TEXT(2)="but the packed component is different, what do you want to do?"
        . D FORMAT^PXRMTEXT(1,70,2,.TEXT,.NOUT,.TEXTO)
        . F IND=1:1:NOUT W !,TEXTO(IND)
        Q
        ;
        ;==============================================
FOKTI(FILENUM)  ;Check if it is ok to install/transport this FILE.
        ;
        ;Drugs not allowed.
        I FILENUM=50 Q 0
        ;
        ;VA Generic not allowed.
        I FILENUM=50.6 Q 0
        ;
        ;VA Drug Class not allowed.
        I FILENUM=50.605 Q 0
        ;
        ;Lab tests not allowed.
        I FILENUM=60 Q 0
        ;
        ;Radiology procedures not allowed.
        I FILENUM=71 Q 0
        ;
        ;ICD9 (used in Dialogs) not allowed.
        I FILENUM=80 Q 0
        ;
        ;ICD0 not allowed.
        I FILENUM=80.1 Q 0
        ;
        ;CPT (used in Dialogs) not allowed.
        I FILENUM=81 Q 0
        ;
        ;Order Dialogs not allowed.
        I FILENUM=101.41 Q 0
        ;
        ;Orderable Items not allowed.
        I FILENUM=101.43 Q 0
        ;
        ;Sites cannot create entries in GMRV VITAL TYPE.
        I FILENUM=120.51 Q 0
        ;
        ;Mental Health Instruments not allowed.
        I FILENUM=601 Q 0
        I FILENUM=601.71 Q 0
        ;
        I FILENUM=790.404 Q 0
        ;
        ;If control gets to here then it is an allowed file type.
        Q 1
        ;
        ;==============================================
GETFACT(PT01,ATTR,NEWPT01,NAMECHG,IEN)  ;Get the action for a file.
        N ACTION,CHOICES,CSUM,DIR,FILENUM,MSG,RESULT
        N SAME,X,Y
        ;See if this entry is already defined.
CHK     ;
        S NEWPT01=""
        S FILENUM=ATTR("FILE NUMBER")
        I IEN="" S IEN=$$EXISTS^PXRMEXIU(FILENUM,PT01)
        I IEN D
        .;If the entry already exists compare the existing entry checksum
        .;with the packed entry checksum.
        . S CSUM=$$FILE^PXRMEXCS(ATTR("FILE NUMBER"),IEN)
        . S SAME=$S(ATTR("CHECKSUM")=CSUM:1,1:0)
        . D FEIMSG(SAME,.ATTR)
        . I SAME S ACTION="S"
        . I 'SAME D
        .. S CHOICES=$S(FILENUM=801.41:"CMOQS",FILENUM=811.5:"CMOQS",1:"COQS")
        .. S DIR("B")="O"
        .. S ACTION=$$GETACT^PXRMEXIU(CHOICES,.DIR)
        E  D
        . W !!,ATTR("FILE NAME")," entry ",PT01," is NEW,"
        . W !,"what do you want to do?"
        . S CHOICES="CIQS"
        . S DIR("B")="I"
        . S ACTION=$$GETACT^PXRMEXIU(CHOICES,.DIR)
        ;
        I ACTION="Q" Q ACTION
        I ACTION="C" D
        . S NEWPT01=$$GETUNAME^PXRMEXIU(.ATTR)
        .;Make sure the NEW .01 passes any input transforms.
        . I NEWPT01="" S ACTION="S"
        . E  D CHK^DIE(ATTR("FILE NUMBER"),.01,"",NEWPT01,.RESULT,"MSG")
        I $G(RESULT)="^" D  G CHK
        . D AWRITE^PXRMUTIL("MSG")
        . K RESULT
        ;
        I ACTION="O" D
        .;If the action is overwrite double check that is what the user
        .;really wants to do.
        . N DIROUT,DIRUT,DTOUT,DUOUT
        . K DIR
        . S DIR(0)="Y"_U_"A"
        . S DIR("A")="Are you sure you want to overwrite"
        . S DIR("B")="N"
        . D ^DIR
        . I $D(DIROUT)!$D(DIRUT) S Y=0
        . I $D(DTOUT)!$D(DUOUT) S Y=0
        . S ACTION=$S(Y:"O",1:"S")
        ;
        I ACTION="P" D
        . N DIC,Y
        . S DIC=ATTR("FILE NUMBER")
        . S DIC(0)="AEMQ"
        . D ^DIC
        . I Y=-1 S ACTION="S"
        . E  S NEWPT01=$P(Y,U,2)
        ;
        I NEWPT01'="" S NAMECHG(ATTR("FILE NUMBER"),PT01)=NEWPT01
        Q ACTION
        ;
        ;==============================================
SETATTR(ATTR,FILE,PT01) ;Set the file attributes for the file FILE.
        N MSG
        S ATTR("FILE NUMBER")=FILE
        S ATTR("FILE NAME")=$$GET1^DID(FILE,"","","NAME","","MSG")
        ;This call gets the field length.
        D FIELD^DID(FILE,.01,"","FIELD LENGTH","ATTR","MSG")
        S ATTR("MIN FIELD LENGTH")=3
        S (ATTR("NAME"),ATTR("PT01"))=PT01
        Q
        ;