- FH55PST ;Hines OIFO/RTK RECURRING MEALS RELEASE POST-INIT ;2/18/03 10:15
- ;;5.5;DIETETICS;;Jan 28, 2005
- ;
- I $P($G(^FH(119.9,1,"CV")),U,1)=1 Q ;QUIT IF 5.5 PREVIOUSLY INSTALLED
- ITEM1 ;Convert file .01 field of file #115. The .01 field was a pointer to
- ;the Patient (#2) file, it is being changed to a free text field which
- ;will look like P## or N##, for either a pointer to the Patient (#2)
- ;file or the New Person (#200) file. For example, P27 will be a pointer
- ;to entry #27 in file #2 and N1866 will be a pointer to entry #1866 in
- ;file #200. In addition there will be 2 new pointer fields in file #115
- ;which will be mutually exclusive pointer field to files #2 and #200:
- ; FIELD #14 - PATIENT will be a pointer to file #2.
- ; FIELD #15 - NEW PERSON will be a pointer to file #200.
- ;Each entry in file #115 will have a value in EITHER field #14 or #15.
- ;
- F FHPTIEN=0:0 S FHPTIEN=$O(^FHPT(FHPTIEN)) Q:FHPTIEN'>0 D
- .S FHPT1=$P($G(^FHPT(FHPTIEN,0)),U,1)
- .S FHPT26=$P($G(^FHPT(FHPTIEN,0)),U,2,6)
- .I FHPT1?1.25N,$D(^DPT(FHPT1)) D
- ..S FHNEW1="P"_FHPT1
- ..S FHZNODE=FHNEW1_"^"_FHPT26
- ..S ^FHPT(FHPTIEN,0)=FHZNODE
- ..I $D(^DPT(FHPTIEN,.1)) S DA=FHPTIEN,DR="13////^S X=""I""",DIE="^FHPT(" D ^DIE
- ..Q
- .Q
- ;
- ITEM2 ;Populate/ensure integrity of fields #14 (PATIENT) and #15 (NEW PERSON)
- ;in file #115. Each entry in #115 should have a pointer value in
- ;EITHER field #14 or #15.
- F FHPTIEN=0:0 S FHPTIEN=$O(^FHPT(FHPTIEN)) Q:FHPTIEN'>0 D
- .S FHPT1=$P($G(^FHPT(FHPTIEN,0)),U,1),FHPTTYP=$E(FHPT1,1)
- .I FHPTTYP'="P",FHPTTYP'="N" Q
- .S FHPTR=$E(FHPT1,2,99)
- .I FHPTTYP="P" D
- ..I '$D(^DPT(FHPTR)) Q
- ..K DIE S DA=FHPTIEN,DIE="^FHPT(",DR="14////^S X=FHPTR;15///@" D ^DIE
- .I FHPTTYP="N" D
- ..I '$D(^VA(200,FHPTR)) Q
- ..K DIE S DA=FHPTIEN,DIE="^FHPT(",DR="15////^S X=FHPTR;14///@" D ^DIE
- .Q
- ;
- ITEM3 ;Re-index the "B" cross-reference on the #.01 field of file #115
- ;Re-index the "AW" cross-reference on the #13 sub-field of the #1 field
- S DIK="^FHPT(",DIK(1)=".01^B" D ENALL^DIK
- S IEN=0 F S IEN=$O(^FHPT(IEN)) Q:IEN'>0 D
- .I '$D(^FHPT(IEN,"A")) Q
- .S DIK="^FHPT(IEN,""A"",",DIK(1)="13^AW",DA(1)=IEN D ENALL^DIK
- ;
- ITEM4 ;Delete data hanging around in Site Parameters (#119.9) file.
- ;Allow post-init to be rerun without deleting values in the newly
- ;created fields
- K ^FH(119.9,1,1) K ^FH(119.9,1,2)
- I $P($G(^FH(119.9,1,"CV")),U,1)=1 Q
- S FHMULT=$P($G(^FH(119.9,1,0)),U,20)
- S ^FH(119.9,1,0)="1^^^^^^^^^^^^^^^^^^^"_FHMULT
- S DIE=119.9,DA=1,DR="101////^S X=1" D ^DIE
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFH55PST 2549 printed Feb 18, 2025@23:12:42 Page 2
- FH55PST ;Hines OIFO/RTK RECURRING MEALS RELEASE POST-INIT ;2/18/03 10:15
- +1 ;;5.5;DIETETICS;;Jan 28, 2005
- +2 ;
- +3 ;QUIT IF 5.5 PREVIOUSLY INSTALLED
- IF $PIECE($GET(^FH(119.9,1,"CV")),U,1)=1
- QUIT
- ITEM1 ;Convert file .01 field of file #115. The .01 field was a pointer to
- +1 ;the Patient (#2) file, it is being changed to a free text field which
- +2 ;will look like P## or N##, for either a pointer to the Patient (#2)
- +3 ;file or the New Person (#200) file. For example, P27 will be a pointer
- +4 ;to entry #27 in file #2 and N1866 will be a pointer to entry #1866 in
- +5 ;file #200. In addition there will be 2 new pointer fields in file #115
- +6 ;which will be mutually exclusive pointer field to files #2 and #200:
- +7 ; FIELD #14 - PATIENT will be a pointer to file #2.
- +8 ; FIELD #15 - NEW PERSON will be a pointer to file #200.
- +9 ;Each entry in file #115 will have a value in EITHER field #14 or #15.
- +10 ;
- +11 FOR FHPTIEN=0:0
- SET FHPTIEN=$ORDER(^FHPT(FHPTIEN))
- if FHPTIEN'>0
- QUIT
- Begin DoDot:1
- +12 SET FHPT1=$PIECE($GET(^FHPT(FHPTIEN,0)),U,1)
- +13 SET FHPT26=$PIECE($GET(^FHPT(FHPTIEN,0)),U,2,6)
- +14 IF FHPT1?1.25N
- IF $DATA(^DPT(FHPT1))
- Begin DoDot:2
- +15 SET FHNEW1="P"_FHPT1
- +16 SET FHZNODE=FHNEW1_"^"_FHPT26
- +17 SET ^FHPT(FHPTIEN,0)=FHZNODE
- +18 IF $DATA(^DPT(FHPTIEN,.1))
- SET DA=FHPTIEN
- SET DR="13////^S X=""I"""
- SET DIE="^FHPT("
- DO ^DIE
- +19 QUIT
- End DoDot:2
- +20 QUIT
- End DoDot:1
- +21 ;
- ITEM2 ;Populate/ensure integrity of fields #14 (PATIENT) and #15 (NEW PERSON)
- +1 ;in file #115. Each entry in #115 should have a pointer value in
- +2 ;EITHER field #14 or #15.
- +3 FOR FHPTIEN=0:0
- SET FHPTIEN=$ORDER(^FHPT(FHPTIEN))
- if FHPTIEN'>0
- QUIT
- Begin DoDot:1
- +4 SET FHPT1=$PIECE($GET(^FHPT(FHPTIEN,0)),U,1)
- SET FHPTTYP=$EXTRACT(FHPT1,1)
- +5 IF FHPTTYP'="P"
- IF FHPTTYP'="N"
- QUIT
- +6 SET FHPTR=$EXTRACT(FHPT1,2,99)
- +7 IF FHPTTYP="P"
- Begin DoDot:2
- +8 IF '$DATA(^DPT(FHPTR))
- QUIT
- +9 KILL DIE
- SET DA=FHPTIEN
- SET DIE="^FHPT("
- SET DR="14////^S X=FHPTR;15///@"
- DO ^DIE
- End DoDot:2
- +10 IF FHPTTYP="N"
- Begin DoDot:2
- +11 IF '$DATA(^VA(200,FHPTR))
- QUIT
- +12 KILL DIE
- SET DA=FHPTIEN
- SET DIE="^FHPT("
- SET DR="15////^S X=FHPTR;14///@"
- DO ^DIE
- End DoDot:2
- +13 QUIT
- End DoDot:1
- +14 ;
- ITEM3 ;Re-index the "B" cross-reference on the #.01 field of file #115
- +1 ;Re-index the "AW" cross-reference on the #13 sub-field of the #1 field
- +2 SET DIK="^FHPT("
- SET DIK(1)=".01^B"
- DO ENALL^DIK
- +3 SET IEN=0
- FOR
- SET IEN=$ORDER(^FHPT(IEN))
- if IEN'>0
- QUIT
- Begin DoDot:1
- +4 IF '$DATA(^FHPT(IEN,"A"))
- QUIT
- +5 SET DIK="^FHPT(IEN,""A"","
- SET DIK(1)="13^AW"
- SET DA(1)=IEN
- DO ENALL^DIK
- End DoDot:1
- +6 ;
- ITEM4 ;Delete data hanging around in Site Parameters (#119.9) file.
- +1 ;Allow post-init to be rerun without deleting values in the newly
- +2 ;created fields
- +3 KILL ^FH(119.9,1,1)
- KILL ^FH(119.9,1,2)
- +4 IF $PIECE($GET(^FH(119.9,1,"CV")),U,1)=1
- QUIT
- +5 SET FHMULT=$PIECE($GET(^FH(119.9,1,0)),U,20)
- +6 SET ^FH(119.9,1,0)="1^^^^^^^^^^^^^^^^^^^"_FHMULT
- +7 SET DIE=119.9
- SET DA=1
- SET DR="101////^S X=1"
- DO ^DIE
- +8 QUIT
