DGPFAAH ;ALB/RPM - PRF ASSIGNMENT HISTORY API'S ; 4/8/04 4:13pm
;;5.3;Registration;**425,554,951,1005,1078**;Aug 13, 1993;Build 3
; Last Edited: SHRPE/sgm - Aug 16, 2018 11:46
;
; ICR# TYPE DESCRIPTION
;----- ---- ---------------------------------------
; 2052 Sup $$GET1^DID
; 2055 Sup $$VFIELD^DILFD
; 2056 Sup GETS^DIQ
; 2053 Sup ^DIE: FILE, UPDATE
;
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,DGDBRS) ;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
; DGDBRS - (optional) If 1, return DBRS info in result array ; dg*951
;
; 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
; "ORIGFAC" .09
; "COMMENT",line#,0 1
; "DBRS",line# 2 (multiple, all fields)
; p1^p2^p3^p4^p5
; p1 = dbrs#
; p2 = dbrs_other
; p3 = create_date_int;ext
; p4 = status_int;ext
; p5 = create_by_int;ext
; p3,p4,p5 - external ';'piece optional
;
;
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
. N ARR,DF,DIERR
. S DGIENS=DGPFIEN_","
. S DF="*"
. I +$G(DGDBRS),$$VFIELD^DILFD(26.14,2) S DF="**"
. D GETS^DIQ(26.14,DGIENS,DF,"IEZ","DGFLDS","DGERR")
. Q:$D(DGERR)
. S DGRSLT=1
. M ARR=DGFLDS(26.14,DGIENS)
. S DGPFAH("ASSIGN")=$G(ARR(.01,"I"))_U_$G(ARR(.01,"E"))
. S DGPFAH("ASSIGNDT")=$G(ARR(.02,"I"))_U_$G(ARR(.02,"E"))
. S DGPFAH("ACTION")=$G(ARR(.03,"I"))_U_$G(ARR(.03,"E"))
. S DGPFAH("ENTERBY")=$G(ARR(.04,"I"))_U_$G(ARR(.04,"E"))
. S DGPFAH("APPRVBY")=$G(ARR(.05,"I"))_U_$G(ARR(.05,"E"))
. S DGPFAH("TIULINK")=$G(ARR(.06,"I"))_U_$G(ARR(.06,"E"))
. ;build review comments word processing array
. M DGPFAH("COMMENT")=ARR(1)
. K DGPFAH("COMMENT","E"),DGPFAH("COMMENT","I")
. ; next two IF statement from DG*5.3*951
. I $D(ARR(.09)) S DGPFAH("ORIGFAC")=ARR(.09,"I")_U_ARR(.09,"E")
. I $D(DGFLDS(26.142)) D GETDBRS
. Q
. ;
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 S DGHIEN=$O(^DGPF(26.14,"C",DGPFIEN,DGEDT,0))
. Q
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
N UPD
;
F DGSUB="ASSIGN","ASSIGNDT","ACTION","ENTERBY","APPRVBY","TIULINK" D
. S DGFLD(DGSUB)=$P($G(DGPFAH(DGSUB)),U)
. Q
I $D(DGPFAH("COMMENT")) M DGFLD("COMMENT")=DGPFAH("COMMENT")
S X=$G(DGPFAH("ORIGFAC")) I +X S DGFLD("ORIGFAC")=+X ; DG*5.3*951
I $D(DGPFAH("DBRS")) M DGFLD("DBRS")=DGPFAH("DBRS") ; DG*5.3*951
;
I $$VALID^DGPFUT("DGPFAAH1",26.14,.DGFLD,.DGPFERR) D
. N X,DIERR
. 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")
. ;patch 1005 - allow for the case of no comments
. I $D(DGFLD("COMMENT")) S DGFDA(26.14,DGIENS,1)=$NA(DGFLD("COMMENT"))
. S X=+$G(DGFLD("ORIGFAC")),DGFDA(26.14,DGIENS,.09)=$S(X<1:"@",X:X) ;DG 1078 Removes receiving sites name, added by a trigger, if incoming value is null.
. ; add in DBRS data to DGFDA
. I $D(DGFLD("DBRS")) D Q:$D(DGERR)
. . D STOHIST^DGPFUT6(DGIENS,.DGFLD,.DGFDA,.DGERR)
. . I $D(DGERR) S DGIEN=0
. . Q
. ;
. ;determine if update or file should be called
. S UPD=(DGIENS["+") I 'UPD D
. . N I,J
. . S I=0 F J=0:0 S I=$O(DGFDA(26.142,I)) Q:I="" I I["+" S UPD=1 Q
. . Q
. ;
. I 'UPD D
. . N DGERR,DIERR
. . D FILE^DIE("","DGFDA","DGERR")
. . I $D(DGERR) S DGIEN=0
. . Q
. E D
. . N DGERR,DGFDAIEN,DIERR
. . S DGFDAIEN=""
. . I DGIENS="+1," S DGFDAIEN="DGFDAIEN",DGFDAIEN(1)=""
. . D UPDATE^DIE("","DGFDA",DGFDAIEN,"DGERR")
. . I $D(DGERR) S DGIEN=0 Q
. . I DGIENS="+1," S DGIEN=+$G(DGFDAIEN(1))
. . Q
. Q
Q $S($G(DGIEN)>0:DGIEN,1:0)
;
GETDBRS ; called from GETHIST
; expects DGFLDS() to contain GETS^DIQ(26.14) with all fields "**"
; Return sorted by DBRS#:
; DGPFAH("DBRS",inc) = p1^p2^p3^p4^p5
; p1=DBRS# p2=Other p3=date_int;ext p4=status_int;ext
; p5=site_int;ext
;
N I,J,X,Y,DBNM,IENS,TMP
S IENS=0 F S IENS=$O(DGFLDS(26.142,IENS)) Q:'IENS D
. N ARR M ARR=DGFLDS(26.142,IENS)
. S (X,DBNM)=$G(ARR(.01,"E")) Q:X=""
. S $P(X,U,2)=$G(ARR(.02,"E"))
. S $P(X,U,3)=$G(ARR(.03,"I"))_";"_$P($G(ARR(.03,"E")),":",1,2)
. S $P(X,U,4)=$G(ARR(.04,"I"))_";"_$G(ARR(.04,"E"))
. S $P(X,U,5)=$G(ARR(.05,"I"))_";"_$G(ARR(.05,"E"))
. S TMP(DBNM,+IENS)=X
. Q
S X="TMP" F J=1:1 S X=$Q(@X) Q:X="" S DGPFAH("DBRS",J)=@X
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPFAAH 10115 printed Oct 16, 2024@18:47:56 Page 2
DGPFAAH ;ALB/RPM - PRF ASSIGNMENT HISTORY API'S ; 4/8/04 4:13pm
+1 ;;5.3;Registration;**425,554,951,1005,1078**;Aug 13, 1993;Build 3
+2 ; Last Edited: SHRPE/sgm - Aug 16, 2018 11:46
+3 ;
+4 ; ICR# TYPE DESCRIPTION
+5 ;----- ---- ---------------------------------------
+6 ; 2052 Sup $$GET1^DID
+7 ; 2055 Sup $$VFIELD^DILFD
+8 ; 2056 Sup GETS^DIQ
+9 ; 2053 Sup ^DIE: FILE, UPDATE
+10 ;
+11 ;no direct entry
QUIT
+12 ;
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,DGDBRS) ;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 ; DGDBRS - (optional) If 1, return DBRS info in result array ; dg*951
+7 ;
+8 ; Output:
+9 ; Function Value - Return 1 on success, 0 on failure
+10 ; DGPFAH - Output array containing the field values
+11 ; Subscript Field#
+12 ; ----------------- ------
+13 ; "ASSIGN" .01
+14 ; "ASSIGNDT" .02
+15 ; "ACTION" .03
+16 ; "ENTERBY" .04
+17 ; "APPRVBY" .05
+18 ; "TIULINK" .06
+19 ; "ORIGFAC" .09
+20 ; "COMMENT",line#,0 1
+21 ; "DBRS",line# 2 (multiple, all fields)
+22 ; p1^p2^p3^p4^p5
+23 ; p1 = dbrs#
+24 ; p2 = dbrs_other
+25 ; p3 = create_date_int;ext
+26 ; p4 = status_int;ext
+27 ; p5 = create_by_int;ext
+28 ; p3,p4,p5 - external ';'piece optional
+29 ;
+30 ;
+31 ;IEN string for DIQ
NEW DGIENS
+32 ;results array for DIQ
NEW DGFLDS
+33 ;error array for DIQ
NEW DGERR
+34 NEW DGRSLT
SET DGRSLT=0
+35 IF $GET(DGPFIEN)>0
IF $DATA(^DGPF(26.14,DGPFIEN))
Begin DoDot:1
+36 NEW ARR,DF,DIERR
+37 SET DGIENS=DGPFIEN_","
+38 SET DF="*"
+39 IF +$GET(DGDBRS)
IF $$VFIELD^DILFD(26.14,2)
SET DF="**"
+40 DO GETS^DIQ(26.14,DGIENS,DF,"IEZ","DGFLDS","DGERR")
+41 if $DATA(DGERR)
QUIT
+42 SET DGRSLT=1
+43 MERGE ARR=DGFLDS(26.14,DGIENS)
+44 SET DGPFAH("ASSIGN")=$GET(ARR(.01,"I"))_U_$GET(ARR(.01,"E"))
+45 SET DGPFAH("ASSIGNDT")=$GET(ARR(.02,"I"))_U_$GET(ARR(.02,"E"))
+46 SET DGPFAH("ACTION")=$GET(ARR(.03,"I"))_U_$GET(ARR(.03,"E"))
+47 SET DGPFAH("ENTERBY")=$GET(ARR(.04,"I"))_U_$GET(ARR(.04,"E"))
+48 SET DGPFAH("APPRVBY")=$GET(ARR(.05,"I"))_U_$GET(ARR(.05,"E"))
+49 SET DGPFAH("TIULINK")=$GET(ARR(.06,"I"))_U_$GET(ARR(.06,"E"))
+50 ;build review comments word processing array
+51 MERGE DGPFAH("COMMENT")=ARR(1)
+52 KILL DGPFAH("COMMENT","E"),DGPFAH("COMMENT","I")
+53 ; next two IF statement from DG*5.3*951
+54 IF $DATA(ARR(.09))
SET DGPFAH("ORIGFAC")=ARR(.09,"I")_U_ARR(.09,"E")
+55 IF $DATA(DGFLDS(26.142))
DO GETDBRS
+56 QUIT
+57 ;
End DoDot:1
+58 QUIT DGRSLT
+59 ;
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
SET DGHIEN=$ORDER(^DGPF(26.14,"C",DGPFIEN,DGEDT,0))
+19 QUIT
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) ;
+1 ;File a PRF ASSIGNMENT HISTORY (#26.14) file record
+2 ;
+3 ; Input:
+4 ; .DGPFAH - (required) Array of values to be filed (see GETHIST tag
+5 ; above for valid array structure)
+6 ; .DGPFERR - (optional) Passed by reference to contain error messages
+7 ;
+8 ; Output:
+9 ; Function Value - Returns IEN of record on success, 0 on failure
+10 ; DGPFERR - Undefined on success, error message on failure
+11 ;
+12 NEW DGSUB
+13 NEW DGFLD
+14 NEW DGIEN
+15 NEW DGIENS
+16 NEW DGFDA
+17 NEW DGFDAIEN
+18 NEW DGERR
+19 NEW UPD
+20 ;
+21 FOR DGSUB="ASSIGN","ASSIGNDT","ACTION","ENTERBY","APPRVBY","TIULINK"
Begin DoDot:1
+22 SET DGFLD(DGSUB)=$PIECE($GET(DGPFAH(DGSUB)),U)
+23 QUIT
End DoDot:1
+24 IF $DATA(DGPFAH("COMMENT"))
MERGE DGFLD("COMMENT")=DGPFAH("COMMENT")
+25 ; DG*5.3*951
SET X=$GET(DGPFAH("ORIGFAC"))
IF +X
SET DGFLD("ORIGFAC")=+X
+26 ; DG*5.3*951
IF $DATA(DGPFAH("DBRS"))
MERGE DGFLD("DBRS")=DGPFAH("DBRS")
+27 ;
+28 IF $$VALID^DGPFUT("DGPFAAH1",26.14,.DGFLD,.DGPFERR)
Begin DoDot:1
+29 NEW X,DIERR
+30 SET DGIEN=$$FNDHIST^DGPFAAH(DGFLD("ASSIGN"),DGFLD("ASSIGNDT"))
+31 IF DGIEN
SET DGIENS=DGIEN_","
+32 IF '$TEST
SET DGIENS="+1,"
+33 SET DGFDA(26.14,DGIENS,.01)=DGFLD("ASSIGN")
+34 SET DGFDA(26.14,DGIENS,.02)=DGFLD("ASSIGNDT")
+35 SET DGFDA(26.14,DGIENS,.03)=DGFLD("ACTION")
+36 SET DGFDA(26.14,DGIENS,.04)=DGFLD("ENTERBY")
+37 SET DGFDA(26.14,DGIENS,.05)=DGFLD("APPRVBY")
+38 SET DGFDA(26.14,DGIENS,.06)=DGFLD("TIULINK")
+39 ;patch 1005 - allow for the case of no comments
+40 IF $DATA(DGFLD("COMMENT"))
SET DGFDA(26.14,DGIENS,1)=$NAME(DGFLD("COMMENT"))
+41 ;DG 1078 Removes receiving sites name, added by a trigger, if incoming value is null.
SET X=+$GET(DGFLD("ORIGFAC"))
SET DGFDA(26.14,DGIENS,.09)=$SELECT(X<1:"@",X:X)
+42 ; add in DBRS data to DGFDA
+43 IF $DATA(DGFLD("DBRS"))
Begin DoDot:2
+44 DO STOHIST^DGPFUT6(DGIENS,.DGFLD,.DGFDA,.DGERR)
+45 IF $DATA(DGERR)
SET DGIEN=0
+46 QUIT
End DoDot:2
if $DATA(DGERR)
QUIT
+47 ;
+48 ;determine if update or file should be called
+49 SET UPD=(DGIENS["+")
IF 'UPD
Begin DoDot:2
+50 NEW I,J
+51 SET I=0
FOR J=0:0
SET I=$ORDER(DGFDA(26.142,I))
if I=""
QUIT
IF I["+"
SET UPD=1
QUIT
+52 QUIT
End DoDot:2
+53 ;
+54 IF 'UPD
Begin DoDot:2
+55 NEW DGERR,DIERR
+56 DO FILE^DIE("","DGFDA","DGERR")
+57 IF $DATA(DGERR)
SET DGIEN=0
+58 QUIT
End DoDot:2
+59 IF '$TEST
Begin DoDot:2
+60 NEW DGERR,DGFDAIEN,DIERR
+61 SET DGFDAIEN=""
+62 IF DGIENS="+1,"
SET DGFDAIEN="DGFDAIEN"
SET DGFDAIEN(1)=""
+63 DO UPDATE^DIE("","DGFDA",DGFDAIEN,"DGERR")
+64 IF $DATA(DGERR)
SET DGIEN=0
QUIT
+65 IF DGIENS="+1,"
SET DGIEN=+$GET(DGFDAIEN(1))
+66 QUIT
End DoDot:2
+67 QUIT
End DoDot:1
+68 QUIT $SELECT($GET(DGIEN)>0:DGIEN,1:0)
+69 ;
GETDBRS ; called from GETHIST
+1 ; expects DGFLDS() to contain GETS^DIQ(26.14) with all fields "**"
+2 ; Return sorted by DBRS#:
+3 ; DGPFAH("DBRS",inc) = p1^p2^p3^p4^p5
+4 ; p1=DBRS# p2=Other p3=date_int;ext p4=status_int;ext
+5 ; p5=site_int;ext
+6 ;
+7 NEW I,J,X,Y,DBNM,IENS,TMP
+8 SET IENS=0
FOR
SET IENS=$ORDER(DGFLDS(26.142,IENS))
if 'IENS
QUIT
Begin DoDot:1
+9 NEW ARR
MERGE ARR=DGFLDS(26.142,IENS)
+10 SET (X,DBNM)=$GET(ARR(.01,"E"))
if X=""
QUIT
+11 SET $PIECE(X,U,2)=$GET(ARR(.02,"E"))
+12 SET $PIECE(X,U,3)=$GET(ARR(.03,"I"))_";"_$PIECE($GET(ARR(.03,"E")),":",1,2)
+13 SET $PIECE(X,U,4)=$GET(ARR(.04,"I"))_";"_$GET(ARR(.04,"E"))
+14 SET $PIECE(X,U,5)=$GET(ARR(.05,"I"))_";"_$GET(ARR(.05,"E"))
+15 SET TMP(DBNM,+IENS)=X
+16 QUIT
End DoDot:1
+17 SET X="TMP"
FOR J=1:1
SET X=$QUERY(@X)
if X=""
QUIT
SET DGPFAH("DBRS",J)=@X
+18 QUIT
