source: WorldVistAEHR/trunk/r/DIETETICS-FH/FH55PST.m

Last change on this file was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.4 KB
Line 
1FH55PST ;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
5ITEM1 ;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 ;
27ITEM2 ;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 ;
42ITEM3 ;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 ;
49ITEM4 ;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
Note: See TracBrowser for help on using the repository browser.