- DGENOEIF ;ALB/TMK - OEF/OIF Conflict - Retrieve Data; OCT-17-2005
- ;;5.3;Registration;**673**;Aug 13,1993
- ;
- GET(DFN,DGOEIF,SORT,IGNORE,LOCK) ;
- ;Description: Get OEF/OIF conflict information for a patient
- ;Input:
- ; DFN - Patient IEN
- ; SORT - 1 to return array by location, 0 to return array by item
- ; - 2 to return array by location and date
- ; IGNORE - ien of 2.3215 sub-node ien to ignore
- ; LOCK = 1 to ignore 'locked' entries
- ;Output:
- ; DGOEIF - the OEF/OIF conflict array, passed by reference
- ; subscripts:
- ; "COUNT" Total # of entries in the multiple
- ; "LAST" The latest episode 'TO' date ^ related OEF/OIF/ UNKNOWN
- ; OEF/OIF code (1,2,3,4)^ien of multiple entry ^
- ; 'FROM' date
- ;
- ; For each entry in the multiple if SORT=0 (n is sequence of the item)
- ; "LOC",n Conflict Location
- ; "FR",n From Date
- ; "TO",n To Date
- ; "LOCK",n Locked Flag
- ; "SITE",n Data Source if from site
- ; "IEN",n IEN of the multiple entry
- ;
- ; For each entry in the multiple if SORT=1 (n is the instance of the
- ; item within the conflict)
- ; For each entry in the multiple if SORT=2 (n is the from date of the
- ; item)
- ; "OEF",n,"LOC" "OIF",n,"LOC" "UNK",n,"LOC" Conflict Location
- ; "OEF",n,"FR" "OIF",n,"FR" "UNK",n,"FR" From Date
- ; "OEF",n,"TO" "OIF",n,"TO" "UNK",n,"TO" To Date
- ; "OEF",n,"LOCK" "OIF",n,"LOCK" "UNK",n,"LOCK" Locked Flag
- ; "OEF",n,"SITE" "OIF",n,"SITE" "UNK",n,"SITE" Site source of data
- ; "OEF",n,"IEN" "OIF",n,"IEN" "UNK",n,"IEN" ien of entry
- ; "OEF","COUNT" "OIF","COUNT" "UNK","COUNT" # of episodes found
- ;
- N DGLOC,ITEM,SIEN,SIEN0,LAST,CT,X,I
- K DGOEIF S DGOEIF("COUNT")=0,SORT=+$G(SORT)
- I '$G(DFN) Q "0^0"
- S SIEN=0,(LAST,LAST(0),LAST(1),LAST(2))=""
- F ITEM=1:1 S SIEN=$O(^DPT(DFN,.3215,SIEN)) Q:'SIEN S SIEN0=$G(^(SIEN,0)) I SIEN0'="" D
- . N X1
- . I SIEN=$G(IGNORE)!$S($G(LOCK):$P(SIEN0,U,4),1:0) S ITEM=ITEM-1 Q
- . ; .01 LOCATION OF SERVICE field.
- . S X=$P(SIEN0,U,1),DGLOC=$E($$EXTERNAL^DILFD(2.3215,.01,"",X),1,3)
- . Q:DGLOC=""
- . S CT(DGLOC)=$G(CT(DGLOC))+1
- . S X1=$S(SORT=1:CT(DGLOC),SORT=2:+$P(SIEN0,U,2),1:0)
- . I 'SORT S DGOEIF("LOC",ITEM)=X,DGOEIF("IEN",ITEM)=SIEN
- . I SORT S DGOEIF(DGLOC,X1,"LOC")=X,DGOEIF(DGLOC,X1,"IEN")=SIEN
- . ; .02 FROM DATE field.
- . S X=$P(SIEN0,"^",2)
- . I 'SORT S DGOEIF("FR",ITEM)=X
- . I SORT S DGOEIF(DGLOC,X1,"FR")=X
- . ; .03 TO DATE field.
- . S X=$P(SIEN0,"^",3)
- . I 'SORT S DGOEIF("TO",ITEM)=X
- . I SORT S DGOEIF(DGLOC,X1,"TO")=X
- . I X>LAST S LAST=X,LAST(0)=DGLOC,LAST(1)=SIEN,LAST(2)=$P(SIEN0,U,2)
- . ; .04 DATA LOCKED field.
- . S X=$P(SIEN0,"^",4)
- . I 'SORT S DGOEIF("LOCK",ITEM)=X
- . I SORT S DGOEIF(DGLOC,X1,"LOCK")=X
- . S X=$P(SIEN0,"^",6),X=$S(X="":"CEV",1:X)
- . I 'SORT S DGOEIF("SITE",ITEM)=X
- . I SORT S DGOEIF(DGLOC,X1,"SITE")=X
- S DGOEIF("COUNT")=ITEM-1,DGOEIF("LAST")=LAST_U_LAST(0)_U_LAST(1)_U_LAST(2)
- I SORT F I="OEF","OIF","UNK" S DGOEIF(I,"COUNT")=+$G(CT(I))
- Q (+$G(DGOEIF("COUNT"))_"^1")
- ;
- UPDLAST(DA,DGX,FUNC) ; Xref code for the last OEF/OIF/ UNKNOWN OEF/OIF
- ; location from index xref on subfile 2.3215; fields .01,.02,.03
- ; DA = array for iens of file 2.3215 (DA(1)=DFN, DA=ien of 2.3215)
- ; FUNC = 1 for set logic 0 for kill logic 2 for 'reset' logic
- ; DGX = X1 array (old values) for kill logic
- ; = X2 array (new values) for set logic
- ; subscrpts: (1)=to date (2)=internal conflict code (3)=from date
- N Z1,Z1O
- Q:'$G(DA)!'$G(DA(1))
- ;
- I FUNC D ; Set logic
- . Q:'$G(DGX(1))!'$G(DGX(2))!'$G(DGX(3))
- . S Z1O=$$LAST(DA(1),DA) ; Latest one before the new one
- . 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))
- . Q:DGX(1)<Z1O ; New one not the latest
- . S DGX("2E")=$E($$EXTERNAL^DILFD(2.3215,.01,"",DGX(2)),1,3)
- . 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")
- ;
- I FUNC=0 D ; Kill logic
- . Q:'$G(DGX(1))!'$G(DGX(2))!'$G(DGX(3))
- . S DGX("2E")=$E($$EXTERNAL^DILFD(2.3215,.01,"",DGX(2)),1,3)
- . K ^DPT("ALOEIF",DGX(1),DGX(3),DGX("2E"),DA(1),DA) K DGX("2E")
- . ;Reset xref to next latest for pt, if any
- . S Z1=$$LAST(DA(1),DA)
- . Q:'Z1!($P(Z1,U,2)="")!'$P(Z1,U,3)!'$P(Z1,U,4) ; No latest entry
- . 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))=""
- ;
- Q
- ;
- LAST(DFN,IGNORE) ; Returns latest 'to' date ^ code for location ^
- ; ien for OEF/OIF/ UNKNOWN OEF/OIF ^ 'from' date
- ; entries in subfile 2.3215
- ; DFN = ien file 2
- ; IGNORE = ien of 2.3215 subfile ien to ignore (used for trigger xref)
- N Z,DGZ
- S Z=$$GET(DFN,.DGZ,0,$G(IGNORE))
- Q $G(DGZ("LAST"))
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGENOEIF 4923 printed Jan 18, 2025@03:43:34 Page 2
- DGENOEIF ;ALB/TMK - OEF/OIF Conflict - Retrieve Data; OCT-17-2005
- +1 ;;5.3;Registration;**673**;Aug 13,1993
- +2 ;
- GET(DFN,DGOEIF,SORT,IGNORE,LOCK) ;
- +1 ;Description: Get OEF/OIF conflict information for a patient
- +2 ;Input:
- +3 ; DFN - Patient IEN
- +4 ; SORT - 1 to return array by location, 0 to return array by item
- +5 ; - 2 to return array by location and date
- +6 ; IGNORE - ien of 2.3215 sub-node ien to ignore
- +7 ; LOCK = 1 to ignore 'locked' entries
- +8 ;Output:
- +9 ; DGOEIF - the OEF/OIF conflict array, passed by reference
- +10 ; subscripts:
- +11 ; "COUNT" Total # of entries in the multiple
- +12 ; "LAST" The latest episode 'TO' date ^ related OEF/OIF/ UNKNOWN
- +13 ; OEF/OIF code (1,2,3,4)^ien of multiple entry ^
- +14 ; 'FROM' date
- +15 ;
- +16 ; For each entry in the multiple if SORT=0 (n is sequence of the item)
- +17 ; "LOC",n Conflict Location
- +18 ; "FR",n From Date
- +19 ; "TO",n To Date
- +20 ; "LOCK",n Locked Flag
- +21 ; "SITE",n Data Source if from site
- +22 ; "IEN",n IEN of the multiple entry
- +23 ;
- +24 ; For each entry in the multiple if SORT=1 (n is the instance of the
- +25 ; item within the conflict)
- +26 ; For each entry in the multiple if SORT=2 (n is the from date of the
- +27 ; item)
- +28 ; "OEF",n,"LOC" "OIF",n,"LOC" "UNK",n,"LOC" Conflict Location
- +29 ; "OEF",n,"FR" "OIF",n,"FR" "UNK",n,"FR" From Date
- +30 ; "OEF",n,"TO" "OIF",n,"TO" "UNK",n,"TO" To Date
- +31 ; "OEF",n,"LOCK" "OIF",n,"LOCK" "UNK",n,"LOCK" Locked Flag
- +32 ; "OEF",n,"SITE" "OIF",n,"SITE" "UNK",n,"SITE" Site source of data
- +33 ; "OEF",n,"IEN" "OIF",n,"IEN" "UNK",n,"IEN" ien of entry
- +34 ; "OEF","COUNT" "OIF","COUNT" "UNK","COUNT" # of episodes found
- +35 ;
- +36 NEW DGLOC,ITEM,SIEN,SIEN0,LAST,CT,X,I
- +37 KILL DGOEIF
- SET DGOEIF("COUNT")=0
- SET SORT=+$GET(SORT)
- +38 IF '$GET(DFN)
- QUIT "0^0"
- +39 SET SIEN=0
- SET (LAST,LAST(0),LAST(1),LAST(2))=""
- +40 FOR ITEM=1:1
- SET SIEN=$ORDER(^DPT(DFN,.3215,SIEN))
- if 'SIEN
- QUIT
- SET SIEN0=$GET(^(SIEN,0))
- IF SIEN0'=""
- Begin DoDot:1
- +41 NEW X1
- +42 IF SIEN=$GET(IGNORE)!$SELECT($GET(LOCK):$PIECE(SIEN0,U,4),1:0)
- SET ITEM=ITEM-1
- QUIT
- +43 ; .01 LOCATION OF SERVICE field.
- +44 SET X=$PIECE(SIEN0,U,1)
- SET DGLOC=$EXTRACT($$EXTERNAL^DILFD(2.3215,.01,"",X),1,3)
- +45 if DGLOC=""
- QUIT
- +46 SET CT(DGLOC)=$GET(CT(DGLOC))+1
- +47 SET X1=$SELECT(SORT=1:CT(DGLOC),SORT=2:+$PIECE(SIEN0,U,2),1:0)
- +48 IF 'SORT
- SET DGOEIF("LOC",ITEM)=X
- SET DGOEIF("IEN",ITEM)=SIEN
- +49 IF SORT
- SET DGOEIF(DGLOC,X1,"LOC")=X
- SET DGOEIF(DGLOC,X1,"IEN")=SIEN
- +50 ; .02 FROM DATE field.
- +51 SET X=$PIECE(SIEN0,"^",2)
- +52 IF 'SORT
- SET DGOEIF("FR",ITEM)=X
- +53 IF SORT
- SET DGOEIF(DGLOC,X1,"FR")=X
- +54 ; .03 TO DATE field.
- +55 SET X=$PIECE(SIEN0,"^",3)
- +56 IF 'SORT
- SET DGOEIF("TO",ITEM)=X
- +57 IF SORT
- SET DGOEIF(DGLOC,X1,"TO")=X
- +58 IF X>LAST
- SET LAST=X
- SET LAST(0)=DGLOC
- SET LAST(1)=SIEN
- SET LAST(2)=$PIECE(SIEN0,U,2)
- +59 ; .04 DATA LOCKED field.
- +60 SET X=$PIECE(SIEN0,"^",4)
- +61 IF 'SORT
- SET DGOEIF("LOCK",ITEM)=X
- +62 IF SORT
- SET DGOEIF(DGLOC,X1,"LOCK")=X
- +63 SET X=$PIECE(SIEN0,"^",6)
- SET X=$SELECT(X="":"CEV",1:X)
- +64 IF 'SORT
- SET DGOEIF("SITE",ITEM)=X
- +65 IF SORT
- SET DGOEIF(DGLOC,X1,"SITE")=X
- End DoDot:1
- +66 SET DGOEIF("COUNT")=ITEM-1
- SET DGOEIF("LAST")=LAST_U_LAST(0)_U_LAST(1)_U_LAST(2)
- +67 IF SORT
- FOR I="OEF","OIF","UNK"
- SET DGOEIF(I,"COUNT")=+$GET(CT(I))
- +68 QUIT (+$GET(DGOEIF("COUNT"))_"^1")
- +69 ;
- 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
- +2 ; DA = array for iens of file 2.3215 (DA(1)=DFN, DA=ien of 2.3215)
- +3 ; FUNC = 1 for set logic 0 for kill logic 2 for 'reset' logic
- +4 ; DGX = X1 array (old values) for kill logic
- +5 ; = X2 array (new values) for set logic
- +6 ; subscrpts: (1)=to date (2)=internal conflict code (3)=from date
- +7 NEW Z1,Z1O
- +8 if '$GET(DA)!'$GET(DA(1))
- QUIT
- +9 ;
- +10 ; Set logic
- IF FUNC
- Begin DoDot:1
- +11 if '$GET(DGX(1))!'$GET(DGX(2))!'$GET(DGX(3))
- QUIT
- +12 ; Latest one before the new one
- SET Z1O=$$LAST(DA(1),DA)
- +13 IF Z1O
- IF $PIECE(Z1O,U,2)'=""
- IF $PIECE(Z1O,U,3)
- IF $PIECE(Z1O,U,4)
- IF Z1O<$GET(DGX(1))
- KILL ^DPT("ALOEIF",+Z1O,$PIECE(Z1O,U,4),$PIECE(Z1O,U,2),DA(1),$PIECE(Z1O,U,3))
- +14 ; New one not the latest
- if DGX(1)<Z1O
- QUIT
- +15 SET DGX("2E")=$EXTRACT($$EXTERNAL^DILFD(2.3215,.01,"",DGX(2)),1,3)
- +16 IF '$DATA(^DPT("ALOEIF",DGX(1),DGX(3),DGX("2E"),DA(1),DA))
- SET ^DPT("ALOEIF",DGX(1),DGX(3),DGX("2E"),DA(1),DA)=""
- KILL DGX("2E")
- End DoDot:1
- +17 ;
- +18 ; Kill logic
- IF FUNC=0
- Begin DoDot:1
- +19 if '$GET(DGX(1))!'$GET(DGX(2))!'$GET(DGX(3))
- QUIT
- +20 SET DGX("2E")=$EXTRACT($$EXTERNAL^DILFD(2.3215,.01,"",DGX(2)),1,3)
- +21 KILL ^DPT("ALOEIF",DGX(1),DGX(3),DGX("2E"),DA(1),DA)
- KILL DGX("2E")
- +22 ;Reset xref to next latest for pt, if any
- +23 SET Z1=$$LAST(DA(1),DA)
- +24 ; No latest entry
- if 'Z1!($PIECE(Z1,U,2)="")!'$PIECE(Z1,U,3)!'$PIECE(Z1,U,4)
- QUIT
- +25 IF Z1
- IF '$DATA(^DPT("ALOEIF",$PIECE(Z1,U),$PIECE(Z1,U,4),$PIECE(Z1,U,2),DA(1),$PIECE(Z1,U,3)))
- SET ^DPT("ALOEIF",$PIECE(Z1,U),$PIECE(Z1,U,4),$PIECE(Z1,U,2),DA(1),$PIECE(Z1,U,3))=""
- End DoDot:1
- +26 ;
- +27 QUIT
- +28 ;
- LAST(DFN,IGNORE) ; Returns latest 'to' date ^ code for location ^
- +1 ; ien for OEF/OIF/ UNKNOWN OEF/OIF ^ 'from' date
- +2 ; entries in subfile 2.3215
- +3 ; DFN = ien file 2
- +4 ; IGNORE = ien of 2.3215 subfile ien to ignore (used for trigger xref)
- +5 NEW Z,DGZ
- +6 SET Z=$$GET(DFN,.DGZ,0,$GET(IGNORE))
- +7 QUIT $GET(DGZ("LAST"))
- +8 ;