source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/VADPT6.m@ 1651

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

initial load of WorldVistAEHR

File size: 2.4 KB
Line 
1VADPT6 ;ALB/MJK - PATIENT ID VARIABLES ; 12 AUG 89 @1200
2 ;;5.3;Registration;;Aug 13, 1993
3 ;
4PID ;
513 ; -- Returns the patient id variables for DFN patient
6 ; usually VA("PID")=123-45-6789 and VA("BID")="6789"
7 ; for VA patients.
8 ;
9 ; -- Returns patient id variables as defined for the requested
10 ; patient eligibility for DFN patient. The variable VAPTYP should
11 ; contain the internal number of the desired patient eligibility.
12 ;
13 ; If the VAPTYP eligibility does not exist, then the standard
14 ; values, as defined above, will be passed back.
15 ;
16 N X,L,B K VAERR S (L,B)=""
17 ; L = long id ; B = brief or short id
18 S VAERR=$S('$D(DFN)#2:1,'$D(^DPT(+DFN,0)):1,1:0) I VAERR G PIDQ
19 I $D(VAPTYP),$D(^DPT(DFN,"E",+VAPTYP,0)) S X=^(0),L=$P(X,"^",3),B=$P(X,"^",4)
20 ; -- set default id's
21 I L="",$D(^DPT(DFN,.36)) S X=^(.36) I +X S L=$P(X,"^",3),B=$P(X,"^",4)
22 I L="" S X=$P(^DPT(DFN,0),"^",9) I X]"" S L=$E(X,1,3)_"-"_$E(X,4,5)_"-"_$E(X,6,10),B=$E(X,6,10)
23 ;
24PIDQ S VA("PID")=L,VA("BID")=B Q
25 ;
26SET ;-- execute id format specific long id, short id and x-ref set logic
27 ; input: VADFN == DFN
28 ;
29 Q:'$D(^DPT(VADFN,"E",0))
30 N X,DA S DA(1)=VADFN
31 F DA=0:0 S DA=$O(^DPT(DA(1),"E",DA)) Q:'DA I $D(^(DA,0)) D SET1
32 K X,DA
33 Q
34SET1 ;
35 D CHK G SET1Q:'VAFMT
36 ; -- calc/store long id
37 S X=""
38 I $D(^DIC(8.2,VAFMT,"LONG")) X ^("LONG") S $P(^DPT(DA(1),"E",DA,0),U,3)=X
39 ; -- long id x-refs (set logic)
40 S VAX=X G SET1Q:X=""
41 F VAIX=0:0 S VAIX=$O(^DD(2.0361,.03,1,VAIX)) Q:'VAIX X ^(VAIX,1) S X=VAX
42 ; -- short id x-refs (set logic)
43 S (VAX,X)=$P(^DPT(DA(1),"E",DA,0),U,4) G SET1Q:X=""
44 F VAIX=0:0 S VAIX=$O(^DD(2.0361,.04,1,VAIX)) Q:'VAIX X ^(VAIX,1) S X=VAX
45SET1Q K VAIX,VAX,X,VAFMT
46 Q
47 ;
48KILL ; -- execute id format specific x-ref kill logic
49 ; input: VADFN ==> DFN
50 ;
51 Q:'$D(^DPT(VADFN,"E",0))
52 N X,DA S DA(1)=VADFN
53 F DA=0:0 S DA=$O(^DPT(DA(1),"E",DA)) Q:'DA I $D(^(DA,0)) D KILL1
54 K X,DA
55 Q
56 ;
57KILL1 ;
58 D CHK G KILL1Q:'VAFMT
59 ; -- short id x-ref (kill logic)
60 S (VAX,X)=$P(^DPT(DA(1),"E",DA,0),U,4) G KILL2:X=""
61 F VAIX=0:0 S VAIX=$O(^DD(2.0361,.04,1,VAIX)) Q:'VAIX X ^(VAIX,2) S X=VAX
62 S $P(^DPT(DA(1),"E",DA,0),U,4)=""
63KILL2 ; -- long id (kill logic)
64 S (VAX,X)=$P(^DPT(DA(1),"E",DA,0),U,3) G KILL1Q:X=""
65 F VAIX=0:0 S VAIX=$O(^DD(2.0361,.03,1,VAIX)) Q:'VAIX X ^(VAIX,2) S X=VAX
66 S $P(^DPT(DA(1),"E",DA,0),U,3)=""
67KILL1Q K VAX,VAIX,VAFMT
68 Q
69 ;
70CHK ; -- ok to proceed ; fmt defined
71 S VAFMT=0
72 I $D(^DIC(8,DA,0)) S VAFMT=+$P(^(0),U,10),VAFMT=$S($D(^DIC(8.2,VAFMT,0)):VAFMT,1:0)
73 Q
Note: See TracBrowser for help on using the repository browser.