- 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 Jan 18, 2025@03:48 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