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

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

initial load of FOIAVistA 6/30/08 version
File size: 4.7 KB
Line 
1DGENOEIF ;ALB/TMK - OEF/OIF Conflict - Retrieve Data; OCT-17-2005
2 ;;5.3;Registration;**673**;Aug 13,1993
3 ;
4GET(DFN,DGOEIF,SORT,IGNORE,LOCK) ;
5 ;Description: Get OEF/OIF conflict information for a patient
6 ;Input:
7 ; DFN - Patient IEN
8 ; SORT - 1 to return array by location, 0 to return array by item
9 ; - 2 to return array by location and date
10 ; IGNORE - ien of 2.3215 sub-node ien to ignore
11 ; LOCK = 1 to ignore 'locked' entries
12 ;Output:
13 ; DGOEIF - the OEF/OIF conflict array, passed by reference
14 ; subscripts:
15 ; "COUNT" Total # of entries in the multiple
16 ; "LAST" The latest episode 'TO' date ^ related OEF/OIF/ UNKNOWN
17 ; OEF/OIF code (1,2,3,4)^ien of multiple entry ^
18 ; 'FROM' date
19 ;
20 ; For each entry in the multiple if SORT=0 (n is sequence of the item)
21 ; "LOC",n Conflict Location
22 ; "FR",n From Date
23 ; "TO",n To Date
24 ; "LOCK",n Locked Flag
25 ; "SITE",n Data Source if from site
26 ; "IEN",n IEN of the multiple entry
27 ;
28 ; For each entry in the multiple if SORT=1 (n is the instance of the
29 ; item within the conflict)
30 ; For each entry in the multiple if SORT=2 (n is the from date of the
31 ; item)
32 ; "OEF",n,"LOC" "OIF",n,"LOC" "UNK",n,"LOC" Conflict Location
33 ; "OEF",n,"FR" "OIF",n,"FR" "UNK",n,"FR" From Date
34 ; "OEF",n,"TO" "OIF",n,"TO" "UNK",n,"TO" To Date
35 ; "OEF",n,"LOCK" "OIF",n,"LOCK" "UNK",n,"LOCK" Locked Flag
36 ; "OEF",n,"SITE" "OIF",n,"SITE" "UNK",n,"SITE" Site source of data
37 ; "OEF",n,"IEN" "OIF",n,"IEN" "UNK",n,"IEN" ien of entry
38 ; "OEF","COUNT" "OIF","COUNT" "UNK","COUNT" # of episodes found
39 ;
40 N DGLOC,ITEM,SIEN,SIEN0,LAST,CT,X,I
41 K DGOEIF S DGOEIF("COUNT")=0,SORT=+$G(SORT)
42 I '$G(DFN) Q "0^0"
43 S SIEN=0,(LAST,LAST(0),LAST(1),LAST(2))=""
44 F ITEM=1:1 S SIEN=$O(^DPT(DFN,.3215,SIEN)) Q:'SIEN S SIEN0=$G(^(SIEN,0)) I SIEN0'="" D
45 . N X1
46 . I SIEN=$G(IGNORE)!$S($G(LOCK):$P(SIEN0,U,4),1:0) S ITEM=ITEM-1 Q
47 . ; .01 LOCATION OF SERVICE field.
48 . S X=$P(SIEN0,U,1),DGLOC=$E($$EXTERNAL^DILFD(2.3215,.01,"",X),1,3)
49 . Q:DGLOC=""
50 . S CT(DGLOC)=$G(CT(DGLOC))+1
51 . S X1=$S(SORT=1:CT(DGLOC),SORT=2:+$P(SIEN0,U,2),1:0)
52 . I 'SORT S DGOEIF("LOC",ITEM)=X,DGOEIF("IEN",ITEM)=SIEN
53 . I SORT S DGOEIF(DGLOC,X1,"LOC")=X,DGOEIF(DGLOC,X1,"IEN")=SIEN
54 . ; .02 FROM DATE field.
55 . S X=$P(SIEN0,"^",2)
56 . I 'SORT S DGOEIF("FR",ITEM)=X
57 . I SORT S DGOEIF(DGLOC,X1,"FR")=X
58 . ; .03 TO DATE field.
59 . S X=$P(SIEN0,"^",3)
60 . I 'SORT S DGOEIF("TO",ITEM)=X
61 . I SORT S DGOEIF(DGLOC,X1,"TO")=X
62 . I X>LAST S LAST=X,LAST(0)=DGLOC,LAST(1)=SIEN,LAST(2)=$P(SIEN0,U,2)
63 . ; .04 DATA LOCKED field.
64 . S X=$P(SIEN0,"^",4)
65 . I 'SORT S DGOEIF("LOCK",ITEM)=X
66 . I SORT S DGOEIF(DGLOC,X1,"LOCK")=X
67 . S X=$P(SIEN0,"^",6),X=$S(X="":"CEV",1:X)
68 . I 'SORT S DGOEIF("SITE",ITEM)=X
69 . I SORT S DGOEIF(DGLOC,X1,"SITE")=X
70 S DGOEIF("COUNT")=ITEM-1,DGOEIF("LAST")=LAST_U_LAST(0)_U_LAST(1)_U_LAST(2)
71 I SORT F I="OEF","OIF","UNK" S DGOEIF(I,"COUNT")=+$G(CT(I))
72 Q (+$G(DGOEIF("COUNT"))_"^1")
73 ;
74UPDLAST(DA,DGX,FUNC) ; Xref code for the last OEF/OIF/ UNKNOWN OEF/OIF
75 ; location from index xref on subfile 2.3215; fields .01,.02,.03
76 ; DA = array for iens of file 2.3215 (DA(1)=DFN, DA=ien of 2.3215)
77 ; FUNC = 1 for set logic 0 for kill logic 2 for 'reset' logic
78 ; DGX = X1 array (old values) for kill logic
79 ; = X2 array (new values) for set logic
80 ; subscrpts: (1)=to date (2)=internal conflict code (3)=from date
81 N Z1,Z1O
82 Q:'$G(DA)!'$G(DA(1))
83 ;
84 I FUNC D ; Set logic
85 . Q:'$G(DGX(1))!'$G(DGX(2))!'$G(DGX(3))
86 . S Z1O=$$LAST(DA(1),DA) ; Latest one before the new one
87 . I Z1O,$P(Z1O,U,2)'="",$P(Z1O,U,3),$P(Z1O,U,4),Z1O<$G(DGX(1)) K ^DPT("ALOEIF",+Z1O,$P(Z1O,U,4),$P(Z1O,U,2),DA(1),$P(Z1O,U,3))
88 . Q:DGX(1)<Z1O ; New one not the latest
89 . S DGX("2E")=$E($$EXTERNAL^DILFD(2.3215,.01,"",DGX(2)),1,3)
90 . I '$D(^DPT("ALOEIF",DGX(1),DGX(3),DGX("2E"),DA(1),DA)) S ^DPT("ALOEIF",DGX(1),DGX(3),DGX("2E"),DA(1),DA)="" K DGX("2E")
91 ;
92 I FUNC=0 D ; Kill logic
93 . Q:'$G(DGX(1))!'$G(DGX(2))!'$G(DGX(3))
94 . S DGX("2E")=$E($$EXTERNAL^DILFD(2.3215,.01,"",DGX(2)),1,3)
95 . K ^DPT("ALOEIF",DGX(1),DGX(3),DGX("2E"),DA(1),DA) K DGX("2E")
96 . ;Reset xref to next latest for pt, if any
97 . S Z1=$$LAST(DA(1),DA)
98 . Q:'Z1!($P(Z1,U,2)="")!'$P(Z1,U,3)!'$P(Z1,U,4) ; No latest entry
99 . I Z1,'$D(^DPT("ALOEIF",$P(Z1,U),$P(Z1,U,4),$P(Z1,U,2),DA(1),$P(Z1,U,3))) S ^DPT("ALOEIF",$P(Z1,U),$P(Z1,U,4),$P(Z1,U,2),DA(1),$P(Z1,U,3))=""
100 ;
101 Q
102 ;
103LAST(DFN,IGNORE) ; Returns latest 'to' date ^ code for location ^
104 ; ien for OEF/OIF/ UNKNOWN OEF/OIF ^ 'from' date
105 ; entries in subfile 2.3215
106 ; DFN = ien file 2
107 ; IGNORE = ien of 2.3215 subfile ien to ignore (used for trigger xref)
108 N Z,DGZ
109 S Z=$$GET(DFN,.DGZ,0,$G(IGNORE))
110 Q $G(DGZ("LAST"))
111 ;
Note: See TracBrowser for help on using the repository browser.