Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DGENOEIF

DGENOEIF.m

Go to the documentation of this file.
  1. DGENOEIF ;ALB/TMK - OEF/OIF Conflict - Retrieve Data; OCT-17-2005
  1. ;;5.3;Registration;**673**;Aug 13,1993
  1. ;
  1. GET(DFN,DGOEIF,SORT,IGNORE,LOCK) ;
  1. ;Description: Get OEF/OIF conflict information for a patient
  1. ;Input:
  1. ; DFN - Patient IEN
  1. ; SORT - 1 to return array by location, 0 to return array by item
  1. ; - 2 to return array by location and date
  1. ; IGNORE - ien of 2.3215 sub-node ien to ignore
  1. ; LOCK = 1 to ignore 'locked' entries
  1. ;Output:
  1. ; DGOEIF - the OEF/OIF conflict array, passed by reference
  1. ; subscripts:
  1. ; "COUNT" Total # of entries in the multiple
  1. ; "LAST" The latest episode 'TO' date ^ related OEF/OIF/ UNKNOWN
  1. ; OEF/OIF code (1,2,3,4)^ien of multiple entry ^
  1. ; 'FROM' date
  1. ;
  1. ; For each entry in the multiple if SORT=0 (n is sequence of the item)
  1. ; "LOC",n Conflict Location
  1. ; "FR",n From Date
  1. ; "TO",n To Date
  1. ; "LOCK",n Locked Flag
  1. ; "SITE",n Data Source if from site
  1. ; "IEN",n IEN of the multiple entry
  1. ;
  1. ; For each entry in the multiple if SORT=1 (n is the instance of the
  1. ; item within the conflict)
  1. ; For each entry in the multiple if SORT=2 (n is the from date of the
  1. ; item)
  1. ; "OEF",n,"LOC" "OIF",n,"LOC" "UNK",n,"LOC" Conflict Location
  1. ; "OEF",n,"FR" "OIF",n,"FR" "UNK",n,"FR" From Date
  1. ; "OEF",n,"TO" "OIF",n,"TO" "UNK",n,"TO" To Date
  1. ; "OEF",n,"LOCK" "OIF",n,"LOCK" "UNK",n,"LOCK" Locked Flag
  1. ; "OEF",n,"SITE" "OIF",n,"SITE" "UNK",n,"SITE" Site source of data
  1. ; "OEF",n,"IEN" "OIF",n,"IEN" "UNK",n,"IEN" ien of entry
  1. ; "OEF","COUNT" "OIF","COUNT" "UNK","COUNT" # of episodes found
  1. ;
  1. N DGLOC,ITEM,SIEN,SIEN0,LAST,CT,X,I
  1. K DGOEIF S DGOEIF("COUNT")=0,SORT=+$G(SORT)
  1. I '$G(DFN) Q "0^0"
  1. S SIEN=0,(LAST,LAST(0),LAST(1),LAST(2))=""
  1. F ITEM=1:1 S SIEN=$O(^DPT(DFN,.3215,SIEN)) Q:'SIEN S SIEN0=$G(^(SIEN,0)) I SIEN0'="" D
  1. . N X1
  1. . I SIEN=$G(IGNORE)!$S($G(LOCK):$P(SIEN0,U,4),1:0) S ITEM=ITEM-1 Q
  1. . ; .01 LOCATION OF SERVICE field.
  1. . S X=$P(SIEN0,U,1),DGLOC=$E($$EXTERNAL^DILFD(2.3215,.01,"",X),1,3)
  1. . Q:DGLOC=""
  1. . S CT(DGLOC)=$G(CT(DGLOC))+1
  1. . S X1=$S(SORT=1:CT(DGLOC),SORT=2:+$P(SIEN0,U,2),1:0)
  1. . I 'SORT S DGOEIF("LOC",ITEM)=X,DGOEIF("IEN",ITEM)=SIEN
  1. . I SORT S DGOEIF(DGLOC,X1,"LOC")=X,DGOEIF(DGLOC,X1,"IEN")=SIEN
  1. . ; .02 FROM DATE field.
  1. . S X=$P(SIEN0,"^",2)
  1. . I 'SORT S DGOEIF("FR",ITEM)=X
  1. . I SORT S DGOEIF(DGLOC,X1,"FR")=X
  1. . ; .03 TO DATE field.
  1. . S X=$P(SIEN0,"^",3)
  1. . I 'SORT S DGOEIF("TO",ITEM)=X
  1. . I SORT S DGOEIF(DGLOC,X1,"TO")=X
  1. . I X>LAST S LAST=X,LAST(0)=DGLOC,LAST(1)=SIEN,LAST(2)=$P(SIEN0,U,2)
  1. . ; .04 DATA LOCKED field.
  1. . S X=$P(SIEN0,"^",4)
  1. . I 'SORT S DGOEIF("LOCK",ITEM)=X
  1. . I SORT S DGOEIF(DGLOC,X1,"LOCK")=X
  1. . S X=$P(SIEN0,"^",6),X=$S(X="":"CEV",1:X)
  1. . I 'SORT S DGOEIF("SITE",ITEM)=X
  1. . I SORT S DGOEIF(DGLOC,X1,"SITE")=X
  1. S DGOEIF("COUNT")=ITEM-1,DGOEIF("LAST")=LAST_U_LAST(0)_U_LAST(1)_U_LAST(2)
  1. I SORT F I="OEF","OIF","UNK" S DGOEIF(I,"COUNT")=+$G(CT(I))
  1. Q (+$G(DGOEIF("COUNT"))_"^1")
  1. ;
  1. UPDLAST(DA,DGX,FUNC) ; Xref code for the last OEF/OIF/ UNKNOWN OEF/OIF
  1. ; location from index xref on subfile 2.3215; fields .01,.02,.03
  1. ; DA = array for iens of file 2.3215 (DA(1)=DFN, DA=ien of 2.3215)
  1. ; FUNC = 1 for set logic 0 for kill logic 2 for 'reset' logic
  1. ; DGX = X1 array (old values) for kill logic
  1. ; = X2 array (new values) for set logic
  1. ; subscrpts: (1)=to date (2)=internal conflict code (3)=from date
  1. N Z1,Z1O
  1. Q:'$G(DA)!'$G(DA(1))
  1. ;
  1. I FUNC D ; Set logic
  1. . Q:'$G(DGX(1))!'$G(DGX(2))!'$G(DGX(3))
  1. . S Z1O=$$LAST(DA(1),DA) ; Latest one before the new one
  1. . 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))
  1. . Q:DGX(1)<Z1O ; New one not the latest
  1. . S DGX("2E")=$E($$EXTERNAL^DILFD(2.3215,.01,"",DGX(2)),1,3)
  1. . 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")
  1. ;
  1. I FUNC=0 D ; Kill logic
  1. . Q:'$G(DGX(1))!'$G(DGX(2))!'$G(DGX(3))
  1. . S DGX("2E")=$E($$EXTERNAL^DILFD(2.3215,.01,"",DGX(2)),1,3)
  1. . K ^DPT("ALOEIF",DGX(1),DGX(3),DGX("2E"),DA(1),DA) K DGX("2E")
  1. . ;Reset xref to next latest for pt, if any
  1. . S Z1=$$LAST(DA(1),DA)
  1. . Q:'Z1!($P(Z1,U,2)="")!'$P(Z1,U,3)!'$P(Z1,U,4) ; No latest entry
  1. . 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))=""
  1. ;
  1. Q
  1. ;
  1. LAST(DFN,IGNORE) ; Returns latest 'to' date ^ code for location ^
  1. ; ien for OEF/OIF/ UNKNOWN OEF/OIF ^ 'from' date
  1. ; entries in subfile 2.3215
  1. ; DFN = ien file 2
  1. ; IGNORE = ien of 2.3215 subfile ien to ignore (used for trigger xref)
  1. N Z,DGZ
  1. S Z=$$GET(DFN,.DGZ,0,$G(IGNORE))
  1. Q $G(DGZ("LAST"))
  1. ;