| 1 | FH55PST ;Hines OIFO/RTK RECURRING MEALS RELEASE POST-INIT  ;2/18/03  10:15
 | 
|---|
| 2 |  ;;5.5;DIETETICS;;Jan 28, 2005
 | 
|---|
| 3 |  ;
 | 
|---|
| 4 |  I $P($G(^FH(119.9,1,"CV")),U,1)=1 Q  ;QUIT IF 5.5 PREVIOUSLY INSTALLED
 | 
|---|
| 5 | ITEM1 ;Convert file .01 field of file #115. The .01 field was a pointer to
 | 
|---|
| 6 |  ;the Patient (#2) file, it is being changed to a free text field which
 | 
|---|
| 7 |  ;will look like P## or N##, for either a pointer to the Patient (#2)
 | 
|---|
| 8 |  ;file or the New Person (#200) file. For example, P27 will be a pointer
 | 
|---|
| 9 |  ;to entry #27 in file #2 and N1866 will be a pointer to entry #1866 in
 | 
|---|
| 10 |  ;file #200. In addition there will be 2 new pointer fields in file #115
 | 
|---|
| 11 |  ;which will be mutually exclusive pointer field to files #2 and #200:
 | 
|---|
| 12 |  ; FIELD #14  - PATIENT will be a pointer to file #2.
 | 
|---|
| 13 |  ; FIELD #15  - NEW PERSON will be a pointer to file #200.
 | 
|---|
| 14 |  ;Each entry in file #115 will have a value in EITHER field #14 or #15.
 | 
|---|
| 15 |  ;
 | 
|---|
| 16 |  F FHPTIEN=0:0 S FHPTIEN=$O(^FHPT(FHPTIEN)) Q:FHPTIEN'>0  D
 | 
|---|
| 17 |  .S FHPT1=$P($G(^FHPT(FHPTIEN,0)),U,1)
 | 
|---|
| 18 |  .S FHPT26=$P($G(^FHPT(FHPTIEN,0)),U,2,6)
 | 
|---|
| 19 |  .I FHPT1?1.25N,$D(^DPT(FHPT1)) D
 | 
|---|
| 20 |  ..S FHNEW1="P"_FHPT1
 | 
|---|
| 21 |  ..S FHZNODE=FHNEW1_"^"_FHPT26
 | 
|---|
| 22 |  ..S ^FHPT(FHPTIEN,0)=FHZNODE
 | 
|---|
| 23 |  ..I $D(^DPT(FHPTIEN,.1)) S DA=FHPTIEN,DR="13////^S X=""I""",DIE="^FHPT(" D ^DIE
 | 
|---|
| 24 |  ..Q
 | 
|---|
| 25 |  .Q
 | 
|---|
| 26 |  ;
 | 
|---|
| 27 | ITEM2 ;Populate/ensure integrity of fields #14 (PATIENT) and #15 (NEW PERSON)
 | 
|---|
| 28 |  ;in file #115.  Each entry in #115 should have a pointer value in
 | 
|---|
| 29 |  ;EITHER field #14 or #15.
 | 
|---|
| 30 |  F FHPTIEN=0:0 S FHPTIEN=$O(^FHPT(FHPTIEN)) Q:FHPTIEN'>0  D
 | 
|---|
| 31 |  .S FHPT1=$P($G(^FHPT(FHPTIEN,0)),U,1),FHPTTYP=$E(FHPT1,1)
 | 
|---|
| 32 |  .I FHPTTYP'="P",FHPTTYP'="N" Q
 | 
|---|
| 33 |  .S FHPTR=$E(FHPT1,2,99)
 | 
|---|
| 34 |  .I FHPTTYP="P" D
 | 
|---|
| 35 |  ..I '$D(^DPT(FHPTR)) Q
 | 
|---|
| 36 |  ..K DIE S DA=FHPTIEN,DIE="^FHPT(",DR="14////^S X=FHPTR;15///@" D ^DIE
 | 
|---|
| 37 |  .I FHPTTYP="N" D
 | 
|---|
| 38 |  ..I '$D(^VA(200,FHPTR)) Q
 | 
|---|
| 39 |  ..K DIE S DA=FHPTIEN,DIE="^FHPT(",DR="15////^S X=FHPTR;14///@" D ^DIE
 | 
|---|
| 40 |  .Q
 | 
|---|
| 41 |  ;
 | 
|---|
| 42 | ITEM3 ;Re-index the "B" cross-reference on the #.01 field of file #115
 | 
|---|
| 43 |  ;Re-index the "AW" cross-reference on the #13 sub-field of the #1 field
 | 
|---|
| 44 |  S DIK="^FHPT(",DIK(1)=".01^B" D ENALL^DIK
 | 
|---|
| 45 |  S IEN=0 F  S IEN=$O(^FHPT(IEN)) Q:IEN'>0  D
 | 
|---|
| 46 |  .I '$D(^FHPT(IEN,"A")) Q
 | 
|---|
| 47 |  .S DIK="^FHPT(IEN,""A"",",DIK(1)="13^AW",DA(1)=IEN D ENALL^DIK
 | 
|---|
| 48 |  ;
 | 
|---|
| 49 | ITEM4 ;Delete data hanging around in Site Parameters (#119.9) file.
 | 
|---|
| 50 |  ;Allow post-init to be rerun without deleting values in the newly
 | 
|---|
| 51 |  ;created fields
 | 
|---|
| 52 |  K ^FH(119.9,1,1) K ^FH(119.9,1,2)
 | 
|---|
| 53 |  I $P($G(^FH(119.9,1,"CV")),U,1)=1 Q
 | 
|---|
| 54 |  S FHMULT=$P($G(^FH(119.9,1,0)),U,20)
 | 
|---|
| 55 |  S ^FH(119.9,1,0)="1^^^^^^^^^^^^^^^^^^^"_FHMULT
 | 
|---|
| 56 |  S DIE=119.9,DA=1,DR="101////^S X=1" D ^DIE
 | 
|---|
| 57 |  Q
 | 
|---|