XUMFEIMF.m

XUMFEIMF ;OIFO-OAK/RAM - Edit IMF ;06/28/00

 ;;8.0;KERNEL;**217,335**;Jul 10, 1995

 ;

 ; $$PARAM^HLCS2 call supported by IA #3552

 ;

 Q

 ;

MAIN ; -- main

 ;

 D INIT,SEL1

 ;

 I $G(DIRUT) G EXIT

 I ERROR H 5 D EXIT G MAIN

 ;

EDT ;

 D PRE,EDIT,POST

 ;

 S DIR(0)="Y",DIR("B")="YES"

 S DIR("A")="Are you ready to update the Institution Master File"

 D ^DIR K DIR

 I $G(DIRUT) D  G EDT

 .W !!,"WARNING: You modified your entry without updating the IMF!"

 G:'Y EDT

 ;

SEND ;

 W !,"...send HL7 message to Master File Server..."

 S PARAM("LLNK")="XUMF IMF MFK^XUMF "_$S('TEST:"FORUM",1:"TEST")

 S PARAM("PROTOCOL")=$O(^ORD(101,"B","XUMF IMF MFN",0))

 D MAIN^XUMFP(4,IEN,0,.PARAM,.ERROR) Q:ERROR

 D MAIN^XUMFI(4,IEN,0,.PARAM,.ERROR)

 ;

 I $G(ERROR) W !,$G(ERROR),!

 I '$G(ERROR) W !,"Sent."

 ;

 H 1

 ;

 L -^DIC(4,IEN)

 ;

 D EXIT G MAIN

 ;

 Q

 ;

INIT ; -- initialize

 ;

 K ^TMP("XUMF MFS",$J),^TMP("HLS",$J),^TMP("HLA",$J),PARAM

 D CLEAN^DILF

 ;

 ;

 S (ERROR,TEST,FLAG)=0

 ;

 I $P($$PARAM^HLCS2,U,3)="T" S TEST=1

 ;

 ;

 S XUMF=1

 ;

 D LOAD^XUMF(4.1)

 ;

 Q

 ;

SEL1 ; -- select one institution

 ;

 D CHK^XUMF333

 ;

 W !

 ;

 K DIR

 S DIR(0)="F^3:7^K:'(X?3N.AN) X"

 S DIR("A")="Enter Station Number"

 D ^DIR Q:$G(DIRUT)

 ;

 S STA=Y

 ;

 S IEN=$O(^DIC(4,"D",STA,0))

 ;

 I 'IEN W "   Invalid selection!" H 2 G SEL1

 ;

 L +^DIC(4,IEN):0 I '$T D  Q

 .S ERROR="1^Another user is editing this entry."

 .W !,ERROR,!

 ;

 I 'IEN D  Q

 .S ERROR="1^Not an existing Station Number,"

 .W !,ERROR,!

 ;

 I $E($$STA^XUAF4(+$G(DUZ(2))),1,3)'=$E(STA,1,3) D  Q

 .S ERROR="1^Option may only be used to edit your facility!"

 .W !,ERROR

 .W !," to edit an inactive faciliy log on to that division"

 .W !," you must have DIVISION in your NEW PERSON multiple."

 .W !!," If Inactive facility not selectable - assign with"

 .W !," XUMGR security key."

 ;

 Q

 ;

PRE ; -- pre-udpate

 ;

 S N0=$G(^DIC(4,+IEN,0))

 S N1=$G(^DIC(4,+IEN,1))

 S N3=$G(^DIC(4,+IEN,3))

 S N4=$G(^DIC(4,+IEN,4))

 S NV=$G(^DIC(4,+IEN,7,1))

 S NP=$G(^DIC(4,+IEN,7,2))

 S N99=$G(^DIC(4,+IEN,99))

 ;

 Q

 ;

EDIT ; -- address edit

 ;

 S DIE("NO^")="BACK"

 ;

 ; edit template

 S DIE=4,DA=IEN

 S DR="[XUMF IMF EDIT]"

 D ^DIE

 ;

 ; if inactive remove parent and visn then quit

 I $P($G(^DIC(4,+IEN,99)),U,4) D  Q

 .K IENS,FDA

 .S IENS="1,"_IEN_","

 .S FDA(4.014,IENS,.01)="@"

 .D FILE^DIE("E","FDA")

 .K IENS,FDA

 .S IENS="2,"_IEN_","

 .S FDA(4.014,IENS,.01)="@"

 .D FILE^DIE("E","FDA")

 .W !

 ;

VN K DIR

 S DIR(0)="N^1:23^"

 S DIR("A")="Enter VISN Number"

 D ^DIR

 ;

 G:'Y VN

 ;

 K IENS,FDA

 S IENS="?+1,"_IEN_","

 S FDA(4.014,IENS,.01)="VISN"

 S FDA(4.014,IENS,1)="VISN "_Y

 D UPDATE^DIE("E","FDA")

 ;

PF ;

 ; parent facility

 W !,"Parent ASSOCIATION - Enter the admin PARENT for this facility"

 S DIE="^DIC(4,"_IEN_",7,"

 S DA(1)=IEN,DA=2

 S DR="1~PARENT"

 D ^DIE

 W !

 ;

 Q

 ;

POST ; -- post update

 ;

 I $P($G(^DIC(4,+IEN,0)),U,2)'=$P($G(N0),U,2) S FLAG=1 Q

 I $G(^DIC(4,+IEN,1))'=$G(N1) S FLAG=1 Q

 I $G(^DIC(4,+IEN,4))'=$G(N4) S FLAG=1 Q

 I $G(^DIC(4,+IEN,3))'=$G(N3) S FLAG=1 Q

 I $G(^DIC(4,+IEN,7,1))'=$G(NV) S FLAG=1 Q

 I $G(^DIC(4,+IEN,7,2))'=$G(NP) S FLAG=1 Q

 I $G(^DIC(4,+IEN,99))'=$G(N99) S FLAG=1 Q

 ;

 Q

 ;

EXIT ; -- clean up

 ;

 D CLEAN^DILF,KILL^XUSCLEAN

 K ^TMP("HLS",$J),^TMP("HLA",$J),^TMP("XUMF MFS",$J)

 ;

 K N0,N1,N3,N4,NV,NP,N99,XUMF,DIRUT,PARAM,DA,DR,DIE

 K DIC,DIR,X,Y,NAME,STA,FLAG,IEN,TEST,ERROR,IENS

 ;

 Q

 ;

XUMFEIMF  ;OIFO-OAK/RAM - Edit IMF ;06/28/00

 +1       ;;8.0;KERNEL;**217,335**;Jul 10, 1995

 +2       ;

 +3       ; $$PARAM^HLCS2 call supported by IA #3552

 +4       ;

 +5        QUIT 

 +6       ;

MAIN      ; -- main

 +1       ;

 +2        DO INIT

           DO SEL1

 +3       ;

 +4        IF $GET(DIRUT)

               GOTO EXIT

 +5        IF ERROR

               HANG 5

               DO EXIT

               GOTO MAIN

 +6       ;

EDT       ;

 +1        DO PRE

           DO EDIT

           DO POST

 +2       ;

 +3        SET DIR(0)="Y"

           SET DIR("B")="YES"

 +4        SET DIR("A")="Are you ready to update the Institution Master File"

 +5        DO ^DIR

           KILL DIR

 +6        IF $GET(DIRUT)

               Begin DoDot:1

 +7                WRITE !!,"WARNING: You modified your entry without updating the IMF!"

               End DoDot:1

               GOTO EDT

 +8        IF 'Y

               GOTO EDT

 +9       ;

SEND      ;

 +1        WRITE !,"...send HL7 message to Master File Server..."

 +2        SET PARAM("LLNK")="XUMF IMF MFK^XUMF "_$SELECT('TEST:"FORUM",1:"TEST")

 +3        SET PARAM("PROTOCOL")=$ORDER(^ORD(101,"B","XUMF IMF MFN",0))

 +4        DO MAIN^XUMFP(4,IEN,0,.PARAM,.ERROR)

           IF ERROR

               QUIT 

 +5        DO MAIN^XUMFI(4,IEN,0,.PARAM,.ERROR)

 +6       ;

 +7        IF $GET(ERROR)

               WRITE !,$GET(ERROR),!

 +8        IF '$GET(ERROR)

               WRITE !,"Sent."

 +9       ;

 +10       HANG 1

 +11      ;

 +12       LOCK -^DIC(4,IEN)

 +13      ;

 +14       DO EXIT

           GOTO MAIN

 +15      ;

 +16       QUIT 

 +17      ;

INIT      ; -- initialize

 +1       ;

 +2        KILL ^TMP("XUMF MFS",$JOB),^TMP("HLS",$JOB),^TMP("HLA",$JOB),PARAM

 +3        DO CLEAN^DILF

 +4       ;

 +5       ;

 +6        SET (ERROR,TEST,FLAG)=0

 +7       ;

 +8        IF $PIECE($$PARAM^HLCS2,U,3)="T"

               SET TEST=1

 +9       ;

 +10      ;

 +11       SET XUMF=1

 +12      ;

 +13       DO LOAD^XUMF(4.1)

 +14      ;

 +15       QUIT 

 +16      ;

SEL1      ; -- select one institution

 +1       ;

 +2        DO CHK^XUMF333

 +3       ;

 +4        WRITE !

 +5       ;

 +6        KILL DIR

 +7        SET DIR(0)="F^3:7^K:'(X?3N.AN) X"

 +8        SET DIR("A")="Enter Station Number"

 +9        DO ^DIR

           IF $GET(DIRUT)

               QUIT 

 +10      ;

 +11       SET STA=Y

 +12      ;

 +13       SET IEN=$ORDER(^DIC(4,"D",STA,0))

 +14      ;

 +15       IF 'IEN

               WRITE "   Invalid selection!"

               HANG 2

               GOTO SEL1

 +16      ;

 +17       LOCK +^DIC(4,IEN):0

           IF '$TEST

               Begin DoDot:1

 +18               SET ERROR="1^Another user is editing this entry."

 +19               WRITE !,ERROR,!

               End DoDot:1

               QUIT 

 +20      ;

 +21       IF 'IEN

               Begin DoDot:1

 +22               SET ERROR="1^Not an existing Station Number,"

 +23               WRITE !,ERROR,!

               End DoDot:1

               QUIT 

 +24      ;

 +25       IF $EXTRACT($$STA^XUAF4(+$GET(DUZ(2))),1,3)'=$EXTRACT(STA,1,3)

               Begin DoDot:1

 +26               SET ERROR="1^Option may only be used to edit your facility!"

 +27               WRITE !,ERROR

 +28               WRITE !," to edit an inactive faciliy log on to that division"

 +29               WRITE !," you must have DIVISION in your NEW PERSON multiple."

 +30               WRITE !!," If Inactive facility not selectable - assign with"

 +31               WRITE !," XUMGR security key."

               End DoDot:1

               QUIT 

 +32      ;

 +33       QUIT 

 +34      ;

PRE       ; -- pre-udpate

 +1       ;

 +2        SET N0=$GET(^DIC(4,+IEN,0))

 +3        SET N1=$GET(^DIC(4,+IEN,1))

 +4        SET N3=$GET(^DIC(4,+IEN,3))

 +5        SET N4=$GET(^DIC(4,+IEN,4))

 +6        SET NV=$GET(^DIC(4,+IEN,7,1))

 +7        SET NP=$GET(^DIC(4,+IEN,7,2))

 +8        SET N99=$GET(^DIC(4,+IEN,99))

 +9       ;

 +10       QUIT 

 +11      ;

EDIT      ; -- address edit

 +1       ;

 +2        SET DIE("NO^")="BACK"

 +3       ;

 +4       ; edit template

 +5        SET DIE=4

           SET DA=IEN

 +6        SET DR="[XUMF IMF EDIT]"

 +7        DO ^DIE

 +8       ;

 +9       ; if inactive remove parent and visn then quit

 +10       IF $PIECE($GET(^DIC(4,+IEN,99)),U,4)

               Begin DoDot:1

 +11               KILL IENS,FDA

 +12               SET IENS="1,"_IEN_","

 +13               SET FDA(4.014,IENS,.01)="@"

 +14               DO FILE^DIE("E","FDA")

 +15               KILL IENS,FDA

 +16               SET IENS="2,"_IEN_","

 +17               SET FDA(4.014,IENS,.01)="@"

 +18               DO FILE^DIE("E","FDA")

 +19               WRITE !

               End DoDot:1

               QUIT 

 +20      ;

VN         KILL DIR

 +1        SET DIR(0)="N^1:23^"

 +2        SET DIR("A")="Enter VISN Number"

 +3        DO ^DIR

 +4       ;

 +5        IF 'Y

               GOTO VN

 +6       ;

 +7        KILL IENS,FDA

 +8        SET IENS="?+1,"_IEN_","

 +9        SET FDA(4.014,IENS,.01)="VISN"

 +10       SET FDA(4.014,IENS,1)="VISN "_Y

 +11       DO UPDATE^DIE("E","FDA")

 +12      ;

PF        ;

 +1       ; parent facility

 +2        WRITE !,"Parent ASSOCIATION - Enter the admin PARENT for this facility"

 +3        SET DIE="^DIC(4,"_IEN_",7,"

 +4        SET DA(1)=IEN

           SET DA=2

 +5        SET DR="1~PARENT"

 +6        DO ^DIE

 +7        WRITE !

 +8       ;

 +9        QUIT 

 +10      ;

POST      ; -- post update

 +1       ;

 +2        IF $PIECE($GET(^DIC(4,+IEN,0)),U,2)'=$PIECE($GET(N0),U,2)

               SET FLAG=1

               QUIT 

 +3        IF $GET(^DIC(4,+IEN,1))'=$GET(N1)

               SET FLAG=1

               QUIT 

 +4        IF $GET(^DIC(4,+IEN,4))'=$GET(N4)

               SET FLAG=1

               QUIT 

 +5        IF $GET(^DIC(4,+IEN,3))'=$GET(N3)

               SET FLAG=1

               QUIT 

 +6        IF $GET(^DIC(4,+IEN,7,1))'=$GET(NV)

               SET FLAG=1

               QUIT 

 +7        IF $GET(^DIC(4,+IEN,7,2))'=$GET(NP)

               SET FLAG=1

               QUIT 

 +8        IF $GET(^DIC(4,+IEN,99))'=$GET(N99)

               SET FLAG=1

               QUIT 

 +9       ;

 +10       QUIT 

 +11      ;

EXIT      ; -- clean up

 +1       ;

 +2        DO CLEAN^DILF

           DO KILL^XUSCLEAN

 +3        KILL ^TMP("HLS",$JOB),^TMP("HLA",$JOB),^TMP("XUMF MFS",$JOB)

 +4       ;

 +5        KILL N0,N1,N3,N4,NV,NP,N99,XUMF,DIRUT,PARAM,DA,DR,DIE

 +6        KILL DIC,DIR,X,Y,NAME,STA,FLAG,IEN,TEST,ERROR,IENS

 +7       ;

 +8        QUIT 

 +9       ;