source: FOIAVistA/tag/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGPWPOST.m@ 636

Last change on this file since 636 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.1 KB
Line 
1DGPWPOST ;ALB/CM POST INIT FOR WRISTBAND ; 12/4/95
2 ;;5.3;Registration;**62**;Aug 13, 1993
3 ;
4 ;This post init will add the Wristband entry to the EMBOSSED CARD
5 ;TYPE file #39.1. The entry is added via the post init due to the
6 ;pointer values that are included in the entry, they could be different
7 ;values from site to site.
8 ;
9EN ;
10 ;Add WRISTBAND entry to the file
11 W !!,"Post Init...."
12 S DIC="^DIC(39.1,",DIC(0)="LZM",DLAYGO=39.1,X="WRISTBAND"
13 D ^DIC
14 K DIC,DLAYGO,X
15 I +Y<0 W !,"Unable to add WRISTBAND entry to file 39.1",!,"Contact your IRMFO for assistance.",! Q
16 I $P(Y,U,3)'=1 W !,"An entry already exists for WRISTBAND in EMBOSSED CARD file (#39.1)." Q
17 N ENTRY
18 S ENTRY=+Y
19 W !,"Adding WRISTBAND entry to EMBOSSED CARD TYPE file (#39.1)...",!
20 ;
21 ;look up data items in Embossing Data file #39.2 to be added to the
22 ;WRISTBAND entry
23 ;
24 N WARD,PID,BIRTH,BLANK,ALL,REL,NAME
25 ;
26 F X="WARD LOCATION","PID","NAME","DOB","RELIGION","BLANK","ALLERGY" D
27 .S DIC="^DIC(39.2,",DIC(0)="ZMOX",DLAYGO=39.2
28 .D ^DIC
29 .I +Y<0 W !,"Unable to find "_X_" in file 39.2.",!,"Contact your IRMFO for assistance.",! Q
30 .I X="WARD LOCATION" S WARD=+Y
31 .I X="PID" S PID=+Y
32 .I X="NAME" S NAME=+Y
33 .I X="DOB" S BIRTH=+Y
34 .I X="RELIGION" S REL=+Y
35 .I X="BLANK" S BLANK=+Y
36 .I X="ALLERGY" S ALL=+Y
37 .K Y,X,DIC
38 ;
39 ;Hard set the global entry
40 ;
41 S ^DIC(39.1,ENTRY,0)="WRISTBAND^^^1^^"_ENTRY
42 S ^DIC(39.1,ENTRY,1,0)="^39.11^^4"
43 S ^DIC(39.1,ENTRY,1,1,0)=1
44 S ^DIC(39.1,ENTRY,1,1,1,0)="^39.12P^2^2"
45 S ^DIC(39.1,ENTRY,1,1,1,1,0)=NAME_"^1^30"
46 S ^DIC(39.1,ENTRY,1,1,1,2,0)=WARD_"^32^30"
47 S ^DIC(39.1,ENTRY,1,2,0)=2
48 S ^DIC(39.1,ENTRY,1,2,1,0)="^39.12P^3^3"
49 S ^DIC(39.1,ENTRY,1,2,1,1,0)=PID_"^1^14"
50 S ^DIC(39.1,ENTRY,1,2,1,2,0)=BIRTH_"^17^12"
51 S ^DIC(39.1,ENTRY,1,2,1,3,0)=REL_"^35^2"
52 S ^DIC(39.1,ENTRY,1,3,0)=3
53 S ^DIC(39.1,ENTRY,1,3,1,0)="^39.12P^1^1"
54 S ^DIC(39.1,ENTRY,1,3,1,1,0)=BLANK_"^1"
55 S ^DIC(39.1,ENTRY,1,4,0)=4
56 S ^DIC(39.1,ENTRY,1,4,1,0)="^39.12P^1^1"
57 S ^DIC(39.1,ENTRY,1,4,1,1,0)=ALL_"^1^40"
58 ;
59 ;Re-index "C" cross reference
60 S DIK="^DIC(39.1,",DA=ENTRY,DIK(1)="5^C"
61 D EN^DIK
62 K DIK,DA
63 ;
64 W !,"Post Init completed."
65 Q
Note: See TracBrowser for help on using the repository browser.