| [613] | 1 | XUMFEIMF ;OIFO-OAK/RAM - Edit IMF ;06/28/00
|
|---|
| 2 | ;;8.0;KERNEL;**217,335**;Jul 10, 1995
|
|---|
| 3 | ;
|
|---|
| 4 | ; $$PARAM^HLCS2 call supported by IA #3552
|
|---|
| 5 | ;
|
|---|
| 6 | Q
|
|---|
| 7 | ;
|
|---|
| 8 | MAIN ; -- main
|
|---|
| 9 | ;
|
|---|
| 10 | D INIT,SEL1
|
|---|
| 11 | ;
|
|---|
| 12 | I $G(DIRUT) G EXIT
|
|---|
| 13 | I ERROR H 5 D EXIT G MAIN
|
|---|
| 14 | ;
|
|---|
| 15 | EDT ;
|
|---|
| 16 | D PRE,EDIT,POST
|
|---|
| 17 | ;
|
|---|
| 18 | S DIR(0)="Y",DIR("B")="YES"
|
|---|
| 19 | S DIR("A")="Are you ready to update the Institution Master File"
|
|---|
| 20 | D ^DIR K DIR
|
|---|
| 21 | I $G(DIRUT) D G EDT
|
|---|
| 22 | .W !!,"WARNING: You modified your entry without updating the IMF!"
|
|---|
| 23 | G:'Y EDT
|
|---|
| 24 | ;
|
|---|
| 25 | SEND ;
|
|---|
| 26 | W !,"...send HL7 message to Master File Server..."
|
|---|
| 27 | S PARAM("LLNK")="XUMF IMF MFK^XUMF "_$S('TEST:"FORUM",1:"TEST")
|
|---|
| 28 | S PARAM("PROTOCOL")=$O(^ORD(101,"B","XUMF IMF MFN",0))
|
|---|
| 29 | D MAIN^XUMFP(4,IEN,0,.PARAM,.ERROR) Q:ERROR
|
|---|
| 30 | D MAIN^XUMFI(4,IEN,0,.PARAM,.ERROR)
|
|---|
| 31 | ;
|
|---|
| 32 | I $G(ERROR) W !,$G(ERROR),!
|
|---|
| 33 | I '$G(ERROR) W !,"Sent."
|
|---|
| 34 | ;
|
|---|
| 35 | H 1
|
|---|
| 36 | ;
|
|---|
| 37 | L -^DIC(4,IEN)
|
|---|
| 38 | ;
|
|---|
| 39 | D EXIT G MAIN
|
|---|
| 40 | ;
|
|---|
| 41 | Q
|
|---|
| 42 | ;
|
|---|
| 43 | INIT ; -- initialize
|
|---|
| 44 | ;
|
|---|
| 45 | K ^TMP("XUMF MFS",$J),^TMP("HLS",$J),^TMP("HLA",$J),PARAM
|
|---|
| 46 | D CLEAN^DILF
|
|---|
| 47 | ;
|
|---|
| 48 | ;
|
|---|
| 49 | S (ERROR,TEST,FLAG)=0
|
|---|
| 50 | ;
|
|---|
| 51 | I $P($$PARAM^HLCS2,U,3)="T" S TEST=1
|
|---|
| 52 | ;
|
|---|
| 53 | ;
|
|---|
| 54 | S XUMF=1
|
|---|
| 55 | ;
|
|---|
| 56 | D LOAD^XUMF(4.1)
|
|---|
| 57 | ;
|
|---|
| 58 | Q
|
|---|
| 59 | ;
|
|---|
| 60 | SEL1 ; -- select one institution
|
|---|
| 61 | ;
|
|---|
| 62 | D CHK^XUMF333
|
|---|
| 63 | ;
|
|---|
| 64 | W !
|
|---|
| 65 | ;
|
|---|
| 66 | K DIR
|
|---|
| 67 | S DIR(0)="F^3:7^K:'(X?3N.AN) X"
|
|---|
| 68 | S DIR("A")="Enter Station Number"
|
|---|
| 69 | D ^DIR Q:$G(DIRUT)
|
|---|
| 70 | ;
|
|---|
| 71 | S STA=Y
|
|---|
| 72 | ;
|
|---|
| 73 | S IEN=$O(^DIC(4,"D",STA,0))
|
|---|
| 74 | ;
|
|---|
| 75 | I 'IEN W " Invalid selection!" H 2 G SEL1
|
|---|
| 76 | ;
|
|---|
| 77 | L +^DIC(4,IEN):0 I '$T D Q
|
|---|
| 78 | .S ERROR="1^Another user is editing this entry."
|
|---|
| 79 | .W !,ERROR,!
|
|---|
| 80 | ;
|
|---|
| 81 | I 'IEN D Q
|
|---|
| 82 | .S ERROR="1^Not an existing Station Number,"
|
|---|
| 83 | .W !,ERROR,!
|
|---|
| 84 | ;
|
|---|
| 85 | I $E($$STA^XUAF4(+$G(DUZ(2))),1,3)'=$E(STA,1,3) D Q
|
|---|
| 86 | .S ERROR="1^Option may only be used to edit your facility!"
|
|---|
| 87 | .W !,ERROR
|
|---|
| 88 | .W !," to edit an inactive faciliy log on to that division"
|
|---|
| 89 | .W !," you must have DIVISION in your NEW PERSON multiple."
|
|---|
| 90 | .W !!," If Inactive facility not selectable - assign with"
|
|---|
| 91 | .W !," XUMGR security key."
|
|---|
| 92 | ;
|
|---|
| 93 | Q
|
|---|
| 94 | ;
|
|---|
| 95 | PRE ; -- pre-udpate
|
|---|
| 96 | ;
|
|---|
| 97 | S N0=$G(^DIC(4,+IEN,0))
|
|---|
| 98 | S N1=$G(^DIC(4,+IEN,1))
|
|---|
| 99 | S N3=$G(^DIC(4,+IEN,3))
|
|---|
| 100 | S N4=$G(^DIC(4,+IEN,4))
|
|---|
| 101 | S NV=$G(^DIC(4,+IEN,7,1))
|
|---|
| 102 | S NP=$G(^DIC(4,+IEN,7,2))
|
|---|
| 103 | S N99=$G(^DIC(4,+IEN,99))
|
|---|
| 104 | ;
|
|---|
| 105 | Q
|
|---|
| 106 | ;
|
|---|
| 107 | EDIT ; -- address edit
|
|---|
| 108 | ;
|
|---|
| 109 | S DIE("NO^")="BACK"
|
|---|
| 110 | ;
|
|---|
| 111 | ; edit template
|
|---|
| 112 | S DIE=4,DA=IEN
|
|---|
| 113 | S DR="[XUMF IMF EDIT]"
|
|---|
| 114 | D ^DIE
|
|---|
| 115 | ;
|
|---|
| 116 | ; if inactive remove parent and visn then quit
|
|---|
| 117 | I $P($G(^DIC(4,+IEN,99)),U,4) D Q
|
|---|
| 118 | .K IENS,FDA
|
|---|
| 119 | .S IENS="1,"_IEN_","
|
|---|
| 120 | .S FDA(4.014,IENS,.01)="@"
|
|---|
| 121 | .D FILE^DIE("E","FDA")
|
|---|
| 122 | .K IENS,FDA
|
|---|
| 123 | .S IENS="2,"_IEN_","
|
|---|
| 124 | .S FDA(4.014,IENS,.01)="@"
|
|---|
| 125 | .D FILE^DIE("E","FDA")
|
|---|
| 126 | .W !
|
|---|
| 127 | ;
|
|---|
| 128 | VN K DIR
|
|---|
| 129 | S DIR(0)="N^1:23^"
|
|---|
| 130 | S DIR("A")="Enter VISN Number"
|
|---|
| 131 | D ^DIR
|
|---|
| 132 | ;
|
|---|
| 133 | G:'Y VN
|
|---|
| 134 | ;
|
|---|
| 135 | K IENS,FDA
|
|---|
| 136 | S IENS="?+1,"_IEN_","
|
|---|
| 137 | S FDA(4.014,IENS,.01)="VISN"
|
|---|
| 138 | S FDA(4.014,IENS,1)="VISN "_Y
|
|---|
| 139 | D UPDATE^DIE("E","FDA")
|
|---|
| 140 | ;
|
|---|
| 141 | PF ;
|
|---|
| 142 | ; parent facility
|
|---|
| 143 | W !,"Parent ASSOCIATION - Enter the admin PARENT for this facility"
|
|---|
| 144 | S DIE="^DIC(4,"_IEN_",7,"
|
|---|
| 145 | S DA(1)=IEN,DA=2
|
|---|
| 146 | S DR="1~PARENT"
|
|---|
| 147 | D ^DIE
|
|---|
| 148 | W !
|
|---|
| 149 | ;
|
|---|
| 150 | Q
|
|---|
| 151 | ;
|
|---|
| 152 | POST ; -- post update
|
|---|
| 153 | ;
|
|---|
| 154 | I $P($G(^DIC(4,+IEN,0)),U,2)'=$P($G(N0),U,2) S FLAG=1 Q
|
|---|
| 155 | I $G(^DIC(4,+IEN,1))'=$G(N1) S FLAG=1 Q
|
|---|
| 156 | I $G(^DIC(4,+IEN,4))'=$G(N4) S FLAG=1 Q
|
|---|
| 157 | I $G(^DIC(4,+IEN,3))'=$G(N3) S FLAG=1 Q
|
|---|
| 158 | I $G(^DIC(4,+IEN,7,1))'=$G(NV) S FLAG=1 Q
|
|---|
| 159 | I $G(^DIC(4,+IEN,7,2))'=$G(NP) S FLAG=1 Q
|
|---|
| 160 | I $G(^DIC(4,+IEN,99))'=$G(N99) S FLAG=1 Q
|
|---|
| 161 | ;
|
|---|
| 162 | Q
|
|---|
| 163 | ;
|
|---|
| 164 | EXIT ; -- clean up
|
|---|
| 165 | ;
|
|---|
| 166 | D CLEAN^DILF,KILL^XUSCLEAN
|
|---|
| 167 | K ^TMP("HLS",$J),^TMP("HLA",$J),^TMP("XUMF MFS",$J)
|
|---|
| 168 | ;
|
|---|
| 169 | K N0,N1,N3,N4,NV,NP,N99,XUMF,DIRUT,PARAM,DA,DR,DIE
|
|---|
| 170 | K DIC,DIR,X,Y,NAME,STA,FLAG,IEN,TEST,ERROR,IENS
|
|---|
| 171 | ;
|
|---|
| 172 | Q
|
|---|
| 173 | ;
|
|---|
