DGPFAAH ;ALB/RPM - PRF ASSIGNMENT HISTORY API'S ; 4/8/04 4:13pm
;;5.3;Registration;**425,554,1015**;Aug 13, 1993;Build 21
Q ;no direct entry
;
GETALL(DGPFIEN,DGPFIENS) ;retrieve list of history IENs for an assignment
;
; Input:
; DGPFIEN - (required) Pointer to PRF ASSIGNMENT (#26.13) file
; DGPFIENS - (required) Result array passed by reference
;
; Output:
; Function Value - Count of returned IENs
; DGPFIENS - Output array subscripted by assignment history IENs
;
N DGCNT ;number of returned values
N DGHIEN ;single history IEN
;
S DGCNT=0
I $G(DGPFIEN)>0,$D(^DGPF(26.14,"B",DGPFIEN)) D
. S DGHIEN=0
. F S DGHIEN=$O(^DGPF(26.14,"B",DGPFIEN,DGHIEN)) Q:'DGHIEN D
. . S DGPFIENS(DGHIEN)=""
. . S DGCNT=DGCNT+1
Q DGCNT
;
GETALLDT(DGPFIEN,DGPFIENS) ;retrieve list of history IENs for an assignment
;
; Input:
; DGPFIEN - (required) Pointer to PRF ASSIGNMENT (#26.13) file
; DGPFIENS - (required) Result array passed by reference
;
; Output:
; Function Value - Count of returned IENs
; DGPFIENS - Output array subscripted by assignment history date
;
N DGADT ;assignment date
N DGCNT ;number of returned values
N DGHIEN ;single history IEN
;
S DGCNT=0
I $G(DGPFIEN)>0,$D(^DGPF(26.14,"C",DGPFIEN)) D
. S DGADT=0
. F S DGADT=$O(^DGPF(26.14,"C",DGPFIEN,DGADT)) Q:'DGADT D
. . S DGHIEN=0
. . F S DGHIEN=$O(^DGPF(26.14,"C",DGPFIEN,DGADT,DGHIEN)) Q:'DGHIEN D
. . . S DGPFIENS(DGADT)=DGHIEN
. . . S DGCNT=DGCNT+1
Q DGCNT
;
GETHIST(DGPFIEN,DGPFAH) ;retrieve a single assignment history record
;
; Input:
; DGPFIEN - (required) IEN for record in PRF ASSIGNMENT HISTORY
; (#26.14) file
; DGPFAH - (required) Result array passed by reference
;
; Output:
; Function Value - Return 1 on success, 0 on failure
; DGPFAH - Output array containing the field values
; Subscript Field#
; ----------------- ------
; "ASSIGN" .01
; "ASSIGNDT" .02
; "ACTION" .03
; "ENTERBY" .04
; "APPRVBY" .05
; "TIULINK" .06
; "COMMENT",line#,0 1
;
N DGIENS ;IEN string for DIQ
N DGFLDS ;results array for DIQ
N DGERR ;error array for DIQ
N DGRSLT
S DGRSLT=0
I $G(DGPFIEN)>0,$D(^DGPF(26.14,DGPFIEN)) D
. S DGIENS=DGPFIEN_","
. D GETS^DIQ(26.14,DGIENS,"*","IEZ","DGFLDS","DGERR")
. Q:$D(DGERR)
. S DGRSLT=1
. S DGPFAH("ASSIGN")=$G(DGFLDS(26.14,DGIENS,.01,"I"))_U_$G(DGFLDS(26.14,DGIENS,.01,"E"))
. S DGPFAH("ASSIGNDT")=$G(DGFLDS(26.14,DGIENS,.02,"I"))_U_$G(DGFLDS(26.14,DGIENS,.02,"E"))
. S DGPFAH("ACTION")=$G(DGFLDS(26.14,DGIENS,.03,"I"))_U_$G(DGFLDS(26.14,DGIENS,.03,"E"))
. S DGPFAH("ENTERBY")=$G(DGFLDS(26.14,DGIENS,.04,"I"))_U_$G(DGFLDS(26.14,DGIENS,.04,"E"))
. S DGPFAH("APPRVBY")=$G(DGFLDS(26.14,DGIENS,.05,"I"))_U_$G(DGFLDS(26.14,DGIENS,.05,"E"))
. S DGPFAH("TIULINK")=$G(DGFLDS(26.14,DGIENS,.06,"I"))_U_$G(DGFLDS(26.14,DGIENS,.06,"E"))
. ;build review comments word processing array
. M DGPFAH("COMMENT")=DGFLDS(26.14,DGIENS,1)
. K DGPFAH("COMMENT","E"),DGPFAH("COMMENT","I")
. ;
Q DGRSLT
;
GETFIRST(DGPFIEN) ;get IEN of the initial assignment
;This function returns the IEN of the initial history record for a
;given patient record flag assignment.
;
; Input:
; DGPFIEN - (required) IEN of record in PRF ASSIGNMENT (#26.13) file
;
; Output:
; Function Value - IEN of initial history record on success
; 0 on failure
;
N DGHIEN ;history IEN
N DGEDT ;edit date
N DGPFAH ;history record data array
;
S DGHIEN=0
I $G(DGPFIEN)>0,$D(^DGPF(26.13,DGPFIEN)) D
. S DGEDT=$O(^DGPF(26.14,"C",DGPFIEN,0))
. I DGEDT>0 D
. . S DGHIEN=$O(^DGPF(26.14,"C",DGPFIEN,DGEDT,0))
Q $S($G(DGHIEN)>0:DGHIEN,1:0)
;
GETLAST(DGPFIEN) ;determine IEN of last assignment history record
;This function returns the IEN of the most recent history record for a
;given patient record flag assignment.
;
; Input:
; DGPFIEN - (required) IEN for record in PRF ASSIGNMENT (#26.13) file
;
; Output:
; Function Value - IEN of last history record on success, 0 on failure
;
N DGDAT
N DGHIEN
S DGHIEN=0
I $G(DGPFIEN)>0,$D(^DGPF(26.13,DGPFIEN)) D
. S DGDAT=$O(^DGPF(26.14,"C",DGPFIEN,""),-1)
. I DGDAT>0 D
. . S DGHIEN=$O(^DGPF(26.14,"C",DGPFIEN,DGDAT,0))
Q $S($G(DGHIEN)>0:DGHIEN,1:0)
;
GETADT(DGPFIEN) ;get the initial assignment date
;This function returns the initial assignment date for a given patient
;record flag assignment.
;
; Input:
; DGPFIEN - (required) IEN for record in PRF ASSIGNMENT (#26.13) file
;
; Output:
; Function Value - assignment date in internal^external format on
; success, 0 on failure
;
N DGHIEN ;history IEN
N DGEDT ;edit date
N DGADT ;assignment date
N DGPFAH ;history record data array
;
S DGADT=0
S DGHIEN=0
I $G(DGPFIEN)>0,$D(^DGPF(26.13,DGPFIEN)) D
. S DGEDT=$O(^DGPF(26.14,"C",DGPFIEN,0))
. I DGEDT>0 D
. . S DGHIEN=$O(^DGPF(26.14,"C",DGPFIEN,DGEDT,0))
. . I DGHIEN>0,$$GETHIST^DGPFAAH(DGHIEN,.DGPFAH) D
. . . I $P($G(DGPFAH("ACTION")),U,2)="NEW ASSIGNMENT" D
. . . . S DGADT=$G(DGPFAH("ASSIGNDT"))
Q DGADT
;
FNDHIST(DGAIEN,DGADT) ;Find Assignment
; This function finds a patient record flag assignment record.
;
; Input:
; DGAIEN - Pointer to assignment in the PRF ASSIGNMENT (#26.13) file
; DGADT - Assignment date
;
; Output:
; Function Value - Returns IEN of existing record on success, 0 on
; failure
;
N DGIEN
;
I $G(DGAIEN)>0,($G(DGADT)>0) D
. S DGIEN=$O(^DGPF(26.14,"C",DGAIEN,DGADT,0))
Q $S($G(DGIEN)>0:DGIEN,1:0)
;
STOHIST(DGPFAH,DGPFERR) ;file a PRF ASSIGNMENT HISTORY (#26.14) file record
;
; Input:
; DGPFAH - (required) Array of values to be filed (see GETHIST tag
; above for valid array structure)
; DGPFERR - (optional) Passed by reference to contain error messages
;
; Output:
; Function Value - Returns IEN of record on success, 0 on failure
; DGPFERR - Undefined on success, error message on failure
;
N DGSUB
N DGFLD
N DGIEN
N DGIENS
N DGFDA
N DGFDAIEN
N DGERR
F DGSUB="ASSIGN","ASSIGNDT","ACTION","ENTERBY","APPRVBY","TIULINK" D
. S DGFLD(DGSUB)=$P($G(DGPFAH(DGSUB)),U)
I $D(DGPFAH("COMMENT")) M DGFLD("COMMENT")=DGPFAH("COMMENT")
I $$VALID^DGPFUT("DGPFAAH1",26.14,.DGFLD,.DGPFERR) D
. S DGIEN=$$FNDHIST^DGPFAAH(DGFLD("ASSIGN"),DGFLD("ASSIGNDT"))
. I DGIEN S DGIENS=DGIEN_","
. E S DGIENS="+1,"
. S DGFDA(26.14,DGIENS,.01)=DGFLD("ASSIGN")
. S DGFDA(26.14,DGIENS,.02)=DGFLD("ASSIGNDT")
. S DGFDA(26.14,DGIENS,.03)=DGFLD("ACTION")
. S DGFDA(26.14,DGIENS,.04)=DGFLD("ENTERBY")
. S DGFDA(26.14,DGIENS,.05)=DGFLD("APPRVBY")
. S DGFDA(26.14,DGIENS,.06)=DGFLD("TIULINK")
. S DGFDA(26.14,DGIENS,1)="DGFLD(""COMMENT"")"
. I DGIEN D
. . D FILE^DIE("","DGFDA","DGERR")
. . I $D(DGERR) S DGIEN=0
. E D
. . D UPDATE^DIE("","DGFDA","DGFDAIEN","DGERR")
. . I '$D(DGERR) S DGIEN=$G(DGFDAIEN(1))
Q $S($G(DGIEN)>0:DGIEN,1:0)
DGPFAAH ;ALB/RPM - PRF ASSIGNMENT HISTORY API'S ; 4/8/04 4:13pm
+1 ;;5.3;Registration;**425,554,1015**;Aug 13, 1993;Build 21
+2 ;no direct entry
QUIT
+3 ;
GETALL(DGPFIEN,DGPFIENS) ;retrieve list of history IENs for an assignment
+1 ;
+2 ; Input:
+3 ; DGPFIEN - (required) Pointer to PRF ASSIGNMENT (#26.13) file
+4 ; DGPFIENS - (required) Result array passed by reference
+5 ;
+6 ; Output:
+7 ; Function Value - Count of returned IENs
+8 ; DGPFIENS - Output array subscripted by assignment history IENs
+9 ;
+10 ;number of returned values
NEW DGCNT
+11 ;single history IEN
NEW DGHIEN
+12 ;
+13 SET DGCNT=0
+14 IF $GET(DGPFIEN)>0
IF $DATA(^DGPF(26.14,"B",DGPFIEN))
Begin DoDot:1
+15 SET DGHIEN=0
+16 FOR
SET DGHIEN=$ORDER(^DGPF(26.14,"B",DGPFIEN,DGHIEN))
IF 'DGHIEN
QUIT
Begin DoDot:2
+17 SET DGPFIENS(DGHIEN)=""
+18 SET DGCNT=DGCNT+1
End DoDot:2
End DoDot:1
+19 QUIT DGCNT
+20 ;
GETALLDT(DGPFIEN,DGPFIENS) ;retrieve list of history IENs for an assignment
+1 ;
+2 ; Input:
+3 ; DGPFIEN - (required) Pointer to PRF ASSIGNMENT (#26.13) file
+4 ; DGPFIENS - (required) Result array passed by reference
+5 ;
+6 ; Output:
+7 ; Function Value - Count of returned IENs
+8 ; DGPFIENS - Output array subscripted by assignment history date
+9 ;
+10 ;assignment date
NEW DGADT
+11 ;number of returned values
NEW DGCNT
+12 ;single history IEN
NEW DGHIEN
+13 ;
+14 SET DGCNT=0
+15 IF $GET(DGPFIEN)>0
IF $DATA(^DGPF(26.14,"C",DGPFIEN))
Begin DoDot:1
+16 SET DGADT=0
+17 FOR
SET DGADT=$ORDER(^DGPF(26.14,"C",DGPFIEN,DGADT))
IF 'DGADT
QUIT
Begin DoDot:2
+18 SET DGHIEN=0
+19 FOR
SET DGHIEN=$ORDER(^DGPF(26.14,"C",DGPFIEN,DGADT,DGHIEN))
IF 'DGHIEN
QUIT
Begin DoDot:3
+20 SET DGPFIENS(DGADT)=DGHIEN
+21 SET DGCNT=DGCNT+1
End DoDot:3
End DoDot:2
End DoDot:1
+22 QUIT DGCNT
+23 ;
GETHIST(DGPFIEN,DGPFAH) ;retrieve a single assignment history record
+1 ;
+2 ; Input:
+3 ; DGPFIEN - (required) IEN for record in PRF ASSIGNMENT HISTORY
+4 ; (#26.14) file
+5 ; DGPFAH - (required) Result array passed by reference
+6 ;
+7 ; Output:
+8 ; Function Value - Return 1 on success, 0 on failure
+9 ; DGPFAH - Output array containing the field values
+10 ; Subscript Field#
+11 ; ----------------- ------
+12 ; "ASSIGN" .01
+13 ; "ASSIGNDT" .02
+14 ; "ACTION" .03
+15 ; "ENTERBY" .04
+16 ; "APPRVBY" .05
+17 ; "TIULINK" .06
+18 ; "COMMENT",line#,0 1
+19 ;
+20 ;IEN string for DIQ
NEW DGIENS
+21 ;results array for DIQ
NEW DGFLDS
+22 ;error array for DIQ
NEW DGERR
+23 NEW DGRSLT
+24 SET DGRSLT=0
+25 IF $GET(DGPFIEN)>0
IF $DATA(^DGPF(26.14,DGPFIEN))
Begin DoDot:1
+26 SET DGIENS=DGPFIEN_","
+27 DO GETS^DIQ(26.14,DGIENS,"*","IEZ","DGFLDS","DGERR")
+28 IF $DATA(DGERR)
QUIT
+29 SET DGRSLT=1
+30 SET DGPFAH("ASSIGN")=$GET(DGFLDS(26.14,DGIENS,.01,"I"))_U_$GET(DGFLDS(26.14,DGIENS,.01,"E"))
+31 SET DGPFAH("ASSIGNDT")=$GET(DGFLDS(26.14,DGIENS,.02,"I"))_U_$GET(DGFLDS(26.14,DGIENS,.02,"E"))
+32 SET DGPFAH("ACTION")=$GET(DGFLDS(26.14,DGIENS,.03,"I"))_U_$GET(DGFLDS(26.14,DGIENS,.03,"E"))
+33 SET DGPFAH("ENTERBY")=$GET(DGFLDS(26.14,DGIENS,.04,"I"))_U_$GET(DGFLDS(26.14,DGIENS,.04,"E"))
+34 SET DGPFAH("APPRVBY")=$GET(DGFLDS(26.14,DGIENS,.05,"I"))_U_$GET(DGFLDS(26.14,DGIENS,.05,"E"))
+35 SET DGPFAH("TIULINK")=$GET(DGFLDS(26.14,DGIENS,.06,"I"))_U_$GET(DGFLDS(26.14,DGIENS,.06,"E"))
+36 ;build review comments word processing array
+37 MERGE DGPFAH("COMMENT")=DGFLDS(26.14,DGIENS,1)
+38 KILL DGPFAH("COMMENT","E"),DGPFAH("COMMENT","I")
+39 ;
End DoDot:1
+40 QUIT DGRSLT
+41 ;
GETFIRST(DGPFIEN) ;get IEN of the initial assignment
+1 ;This function returns the IEN of the initial history record for a
+2 ;given patient record flag assignment.
+3 ;
+4 ; Input:
+5 ; DGPFIEN - (required) IEN of record in PRF ASSIGNMENT (#26.13) file
+6 ;
+7 ; Output:
+8 ; Function Value - IEN of initial history record on success
+9 ; 0 on failure
+10 ;
+11 ;history IEN
NEW DGHIEN
+12 ;edit date
NEW DGEDT
+13 ;history record data array
NEW DGPFAH
+14 ;
+15 SET DGHIEN=0
+16 IF $GET(DGPFIEN)>0
IF $DATA(^DGPF(26.13,DGPFIEN))
Begin DoDot:1
+17 SET DGEDT=$ORDER(^DGPF(26.14,"C",DGPFIEN,0))
+18 IF DGEDT>0
Begin DoDot:2
+19 SET DGHIEN=$ORDER(^DGPF(26.14,"C",DGPFIEN,DGEDT,0))
End DoDot:2
End DoDot:1
+20 QUIT $SELECT($GET(DGHIEN)>0:DGHIEN,1:0)
+21 ;
GETLAST(DGPFIEN) ;determine IEN of last assignment history record
+1 ;This function returns the IEN of the most recent history record for a
+2 ;given patient record flag assignment.
+3 ;
+4 ; Input:
+5 ; DGPFIEN - (required) IEN for record in PRF ASSIGNMENT (#26.13) file
+6 ;
+7 ; Output:
+8 ; Function Value - IEN of last history record on success, 0 on failure
+9 ;
+10 NEW DGDAT
+11 NEW DGHIEN
+12 SET DGHIEN=0
+13 IF $GET(DGPFIEN)>0
IF $DATA(^DGPF(26.13,DGPFIEN))
Begin DoDot:1
+14 SET DGDAT=$ORDER(^DGPF(26.14,"C",DGPFIEN,""),-1)
+15 IF DGDAT>0
Begin DoDot:2
+16 SET DGHIEN=$ORDER(^DGPF(26.14,"C",DGPFIEN,DGDAT,0))
End DoDot:2
End DoDot:1
+17 QUIT $SELECT($GET(DGHIEN)>0:DGHIEN,1:0)
+18 ;
GETADT(DGPFIEN) ;get the initial assignment date
+1 ;This function returns the initial assignment date for a given patient
+2 ;record flag assignment.
+3 ;
+4 ; Input:
+5 ; DGPFIEN - (required) IEN for record in PRF ASSIGNMENT (#26.13) file
+6 ;
+7 ; Output:
+8 ; Function Value - assignment date in internal^external format on
+9 ; success, 0 on failure
+10 ;
+11 ;history IEN
NEW DGHIEN
+12 ;edit date
NEW DGEDT
+13 ;assignment date
NEW DGADT
+14 ;history record data array
NEW DGPFAH
+15 ;
+16 SET DGADT=0
+17 SET DGHIEN=0
+18 IF $GET(DGPFIEN)>0
IF $DATA(^DGPF(26.13,DGPFIEN))
Begin DoDot:1
+19 SET DGEDT=$ORDER(^DGPF(26.14,"C",DGPFIEN,0))
+20 IF DGEDT>0
Begin DoDot:2
+21 SET DGHIEN=$ORDER(^DGPF(26.14,"C",DGPFIEN,DGEDT,0))
+22 IF DGHIEN>0
IF $$GETHIST^DGPFAAH(DGHIEN,.DGPFAH)
Begin DoDot:3
+23 IF $PIECE($GET(DGPFAH("ACTION")),U,2)="NEW ASSIGNMENT"
Begin DoDot:4
+24 SET DGADT=$GET(DGPFAH("ASSIGNDT"))
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+25 QUIT DGADT
+26 ;
FNDHIST(DGAIEN,DGADT) ;Find Assignment
+1 ; This function finds a patient record flag assignment record.
+2 ;
+3 ; Input:
+4 ; DGAIEN - Pointer to assignment in the PRF ASSIGNMENT (#26.13) file
+5 ; DGADT - Assignment date
+6 ;
+7 ; Output:
+8 ; Function Value - Returns IEN of existing record on success, 0 on
+9 ; failure
+10 ;
+11 NEW DGIEN
+12 ;
+13 IF $GET(DGAIEN)>0
IF ($GET(DGADT)>0)
Begin DoDot:1
+14 SET DGIEN=$ORDER(^DGPF(26.14,"C",DGAIEN,DGADT,0))
End DoDot:1
+15 QUIT $SELECT($GET(DGIEN)>0:DGIEN,1:0)
+16 ;
STOHIST(DGPFAH,DGPFERR) ;file a PRF ASSIGNMENT HISTORY (#26.14) file record
+1 ;
+2 ; Input:
+3 ; DGPFAH - (required) Array of values to be filed (see GETHIST tag
+4 ; above for valid array structure)
+5 ; DGPFERR - (optional) Passed by reference to contain error messages
+6 ;
+7 ; Output:
+8 ; Function Value - Returns IEN of record on success, 0 on failure
+9 ; DGPFERR - Undefined on success, error message on failure
+10 ;
+11 NEW DGSUB
+12 NEW DGFLD
+13 NEW DGIEN
+14 NEW DGIENS
+15 NEW DGFDA
+16 NEW DGFDAIEN
+17 NEW DGERR
+18 FOR DGSUB="ASSIGN","ASSIGNDT","ACTION","ENTERBY","APPRVBY","TIULINK"
Begin DoDot:1
+19 SET DGFLD(DGSUB)=$PIECE($GET(DGPFAH(DGSUB)),U)
End DoDot:1
+20 IF $DATA(DGPFAH("COMMENT"))
MERGE DGFLD("COMMENT")=DGPFAH("COMMENT")
+21 IF $$VALID^DGPFUT("DGPFAAH1",26.14,.DGFLD,.DGPFERR)
Begin DoDot:1
+22 SET DGIEN=$$FNDHIST^DGPFAAH(DGFLD("ASSIGN"),DGFLD("ASSIGNDT"))
+23 IF DGIEN
SET DGIENS=DGIEN_","
+24 IF '$TEST
SET DGIENS="+1,"
+25 SET DGFDA(26.14,DGIENS,.01)=DGFLD("ASSIGN")
+26 SET DGFDA(26.14,DGIENS,.02)=DGFLD("ASSIGNDT")
+27 SET DGFDA(26.14,DGIENS,.03)=DGFLD("ACTION")
+28 SET DGFDA(26.14,DGIENS,.04)=DGFLD("ENTERBY")
+29 SET DGFDA(26.14,DGIENS,.05)=DGFLD("APPRVBY")
+30 SET DGFDA(26.14,DGIENS,.06)=DGFLD("TIULINK")
+31 SET DGFDA(26.14,DGIENS,1)="DGFLD(""COMMENT"")"
+32 IF DGIEN
Begin DoDot:2
+33 DO FILE^DIE("","DGFDA","DGERR")
+34 IF $DATA(DGERR)
SET DGIEN=0
End DoDot:2
+35 IF '$TEST
Begin DoDot:2
+36 DO UPDATE^DIE("","DGFDA","DGFDAIEN","DGERR")
+37 IF '$DATA(DGERR)
SET DGIEN=$GET(DGFDAIEN(1))
End DoDot:2
End DoDot:1
+38 QUIT $SELECT($GET(DGIEN)>0:DGIEN,1:0)
