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

DGPFAAH.m

Go to the documentation of this file.
  1. 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
  1. ; Last Edited: SHRPE/sgm - Aug 16, 2018 11:46
  1. ;
  1. ; ICR# TYPE DESCRIPTION
  1. ;----- ---- ---------------------------------------
  1. ; 2052 Sup $$GET1^DID
  1. ; 2055 Sup $$VFIELD^DILFD
  1. ; 2056 Sup GETS^DIQ
  1. ; 2053 Sup ^DIE: FILE, UPDATE
  1. ;
  1. Q ;no direct entry
  1. ;
  1. GETALL(DGPFIEN,DGPFIENS) ;retrieve list of history IENs for an assignment
  1. ;
  1. ; Input:
  1. ; DGPFIEN - (required) Pointer to PRF ASSIGNMENT (#26.13) file
  1. ; DGPFIENS - (required) Result array passed by reference
  1. ;
  1. ; Output:
  1. ; Function Value - Count of returned IENs
  1. ; DGPFIENS - Output array subscripted by assignment history IENs
  1. ;
  1. N DGCNT ;number of returned values
  1. N DGHIEN ;single history IEN
  1. ;
  1. S DGCNT=0
  1. I $G(DGPFIEN)>0,$D(^DGPF(26.14,"B",DGPFIEN)) D
  1. . S DGHIEN=0
  1. . F S DGHIEN=$O(^DGPF(26.14,"B",DGPFIEN,DGHIEN)) Q:'DGHIEN D
  1. . . S DGPFIENS(DGHIEN)=""
  1. . . S DGCNT=DGCNT+1
  1. Q DGCNT
  1. ;
  1. GETALLDT(DGPFIEN,DGPFIENS) ;retrieve list of history IENs for an assignment
  1. ;
  1. ; Input:
  1. ; DGPFIEN - (required) Pointer to PRF ASSIGNMENT (#26.13) file
  1. ; DGPFIENS - (required) Result array passed by reference
  1. ;
  1. ; Output:
  1. ; Function Value - Count of returned IENs
  1. ; DGPFIENS - Output array subscripted by assignment history date
  1. ;
  1. N DGADT ;assignment date
  1. N DGCNT ;number of returned values
  1. N DGHIEN ;single history IEN
  1. ;
  1. S DGCNT=0
  1. I $G(DGPFIEN)>0,$D(^DGPF(26.14,"C",DGPFIEN)) D
  1. . S DGADT=0
  1. . F S DGADT=$O(^DGPF(26.14,"C",DGPFIEN,DGADT)) Q:'DGADT D
  1. . . S DGHIEN=0
  1. . . F S DGHIEN=$O(^DGPF(26.14,"C",DGPFIEN,DGADT,DGHIEN)) Q:'DGHIEN D
  1. . . . S DGPFIENS(DGADT)=DGHIEN
  1. . . . S DGCNT=DGCNT+1
  1. Q DGCNT
  1. ;
  1. GETHIST(DGPFIEN,DGPFAH,DGDBRS) ;retrieve a single assignment history record
  1. ;
  1. ; Input:
  1. ; DGPFIEN - (required) IEN for record in PRF ASSIGNMENT HISTORY
  1. ; (#26.14) file
  1. ; DGPFAH - (required) Result array passed by reference
  1. ; DGDBRS - (optional) If 1, return DBRS info in result array ; dg*951
  1. ;
  1. ; Output:
  1. ; Function Value - Return 1 on success, 0 on failure
  1. ; DGPFAH - Output array containing the field values
  1. ; Subscript Field#
  1. ; ----------------- ------
  1. ; "ASSIGN" .01
  1. ; "ASSIGNDT" .02
  1. ; "ACTION" .03
  1. ; "ENTERBY" .04
  1. ; "APPRVBY" .05
  1. ; "TIULINK" .06
  1. ; "ORIGFAC" .09
  1. ; "COMMENT",line#,0 1
  1. ; "DBRS",line# 2 (multiple, all fields)
  1. ; p1^p2^p3^p4^p5
  1. ; p1 = dbrs#
  1. ; p2 = dbrs_other
  1. ; p3 = create_date_int;ext
  1. ; p4 = status_int;ext
  1. ; p5 = create_by_int;ext
  1. ; p3,p4,p5 - external ';'piece optional
  1. ;
  1. ;
  1. N DGIENS ;IEN string for DIQ
  1. N DGFLDS ;results array for DIQ
  1. N DGERR ;error array for DIQ
  1. N DGRSLT S DGRSLT=0
  1. I $G(DGPFIEN)>0,$D(^DGPF(26.14,DGPFIEN)) D
  1. . N ARR,DF,DIERR
  1. . S DGIENS=DGPFIEN_","
  1. . S DF="*"
  1. . I +$G(DGDBRS),$$VFIELD^DILFD(26.14,2) S DF="**"
  1. . D GETS^DIQ(26.14,DGIENS,DF,"IEZ","DGFLDS","DGERR")
  1. . Q:$D(DGERR)
  1. . S DGRSLT=1
  1. . M ARR=DGFLDS(26.14,DGIENS)
  1. . S DGPFAH("ASSIGN")=$G(ARR(.01,"I"))_U_$G(ARR(.01,"E"))
  1. . S DGPFAH("ASSIGNDT")=$G(ARR(.02,"I"))_U_$G(ARR(.02,"E"))
  1. . S DGPFAH("ACTION")=$G(ARR(.03,"I"))_U_$G(ARR(.03,"E"))
  1. . S DGPFAH("ENTERBY")=$G(ARR(.04,"I"))_U_$G(ARR(.04,"E"))
  1. . S DGPFAH("APPRVBY")=$G(ARR(.05,"I"))_U_$G(ARR(.05,"E"))
  1. . S DGPFAH("TIULINK")=$G(ARR(.06,"I"))_U_$G(ARR(.06,"E"))
  1. . ;build review comments word processing array
  1. . M DGPFAH("COMMENT")=ARR(1)
  1. . K DGPFAH("COMMENT","E"),DGPFAH("COMMENT","I")
  1. . ; next two IF statement from DG*5.3*951
  1. . I $D(ARR(.09)) S DGPFAH("ORIGFAC")=ARR(.09,"I")_U_ARR(.09,"E")
  1. . I $D(DGFLDS(26.142)) D GETDBRS
  1. . Q
  1. . ;
  1. Q DGRSLT
  1. ;
  1. GETFIRST(DGPFIEN) ;get IEN of the initial assignment
  1. ;This function returns the IEN of the initial history record for a
  1. ;given patient record flag assignment.
  1. ;
  1. ; Input:
  1. ; DGPFIEN - (required) IEN of record in PRF ASSIGNMENT (#26.13) file
  1. ;
  1. ; Output:
  1. ; Function Value - IEN of initial history record on success
  1. ; 0 on failure
  1. ;
  1. N DGHIEN ;history IEN
  1. N DGEDT ;edit date
  1. N DGPFAH ;history record data array
  1. ;
  1. S DGHIEN=0
  1. I $G(DGPFIEN)>0,$D(^DGPF(26.13,DGPFIEN)) D
  1. . S DGEDT=$O(^DGPF(26.14,"C",DGPFIEN,0))
  1. . I DGEDT>0 S DGHIEN=$O(^DGPF(26.14,"C",DGPFIEN,DGEDT,0))
  1. . Q
  1. Q $S($G(DGHIEN)>0:DGHIEN,1:0)
  1. ;
  1. GETLAST(DGPFIEN) ;determine IEN of last assignment history record
  1. ;This function returns the IEN of the most recent history record for a
  1. ;given patient record flag assignment.
  1. ;
  1. ; Input:
  1. ; DGPFIEN - (required) IEN for record in PRF ASSIGNMENT (#26.13) file
  1. ;
  1. ; Output:
  1. ; Function Value - IEN of last history record on success, 0 on failure
  1. ;
  1. N DGDAT
  1. N DGHIEN
  1. S DGHIEN=0
  1. I $G(DGPFIEN)>0,$D(^DGPF(26.13,DGPFIEN)) D
  1. . S DGDAT=$O(^DGPF(26.14,"C",DGPFIEN,""),-1)
  1. . I DGDAT>0 D
  1. . . S DGHIEN=$O(^DGPF(26.14,"C",DGPFIEN,DGDAT,0))
  1. Q $S($G(DGHIEN)>0:DGHIEN,1:0)
  1. ;
  1. GETADT(DGPFIEN) ;get the initial assignment date
  1. ;This function returns the initial assignment date for a given patient
  1. ;record flag assignment.
  1. ;
  1. ; Input:
  1. ; DGPFIEN - (required) IEN for record in PRF ASSIGNMENT (#26.13) file
  1. ;
  1. ; Output:
  1. ; Function Value - assignment date in internal^external format on
  1. ; success, 0 on failure
  1. ;
  1. N DGHIEN ;history IEN
  1. N DGEDT ;edit date
  1. N DGADT ;assignment date
  1. N DGPFAH ;history record data array
  1. ;
  1. S DGADT=0
  1. S DGHIEN=0
  1. I $G(DGPFIEN)>0,$D(^DGPF(26.13,DGPFIEN)) D
  1. . S DGEDT=$O(^DGPF(26.14,"C",DGPFIEN,0))
  1. . I DGEDT>0 D
  1. . . S DGHIEN=$O(^DGPF(26.14,"C",DGPFIEN,DGEDT,0))
  1. . . I DGHIEN>0,$$GETHIST^DGPFAAH(DGHIEN,.DGPFAH) D
  1. . . . I $P($G(DGPFAH("ACTION")),U,2)="NEW ASSIGNMENT" D
  1. . . . . S DGADT=$G(DGPFAH("ASSIGNDT"))
  1. Q DGADT
  1. ;
  1. FNDHIST(DGAIEN,DGADT) ;Find Assignment
  1. ; This function finds a patient record flag assignment record.
  1. ;
  1. ; Input:
  1. ; DGAIEN - Pointer to assignment in the PRF ASSIGNMENT (#26.13) file
  1. ; DGADT - Assignment date
  1. ;
  1. ; Output:
  1. ; Function Value - Returns IEN of existing record on success, 0 on
  1. ; failure
  1. ;
  1. N DGIEN
  1. ;
  1. I $G(DGAIEN)>0,($G(DGADT)>0) D
  1. . S DGIEN=$O(^DGPF(26.14,"C",DGAIEN,DGADT,0))
  1. Q $S($G(DGIEN)>0:DGIEN,1:0)
  1. ;
  1. STOHIST(DGPFAH,DGPFERR) ;
  1. ;File a PRF ASSIGNMENT HISTORY (#26.14) file record
  1. ;
  1. ; Input:
  1. ; .DGPFAH - (required) Array of values to be filed (see GETHIST tag
  1. ; above for valid array structure)
  1. ; .DGPFERR - (optional) Passed by reference to contain error messages
  1. ;
  1. ; Output:
  1. ; Function Value - Returns IEN of record on success, 0 on failure
  1. ; DGPFERR - Undefined on success, error message on failure
  1. ;
  1. N DGSUB
  1. N DGFLD
  1. N DGIEN
  1. N DGIENS
  1. N DGFDA
  1. N DGFDAIEN
  1. N DGERR
  1. N UPD
  1. ;
  1. F DGSUB="ASSIGN","ASSIGNDT","ACTION","ENTERBY","APPRVBY","TIULINK" D
  1. . S DGFLD(DGSUB)=$P($G(DGPFAH(DGSUB)),U)
  1. . Q
  1. I $D(DGPFAH("COMMENT")) M DGFLD("COMMENT")=DGPFAH("COMMENT")
  1. S X=$G(DGPFAH("ORIGFAC")) I +X S DGFLD("ORIGFAC")=+X ; DG*5.3*951
  1. I $D(DGPFAH("DBRS")) M DGFLD("DBRS")=DGPFAH("DBRS") ; DG*5.3*951
  1. ;
  1. I $$VALID^DGPFUT("DGPFAAH1",26.14,.DGFLD,.DGPFERR) D
  1. . N X,DIERR
  1. . S DGIEN=$$FNDHIST^DGPFAAH(DGFLD("ASSIGN"),DGFLD("ASSIGNDT"))
  1. . I DGIEN S DGIENS=DGIEN_","
  1. . E S DGIENS="+1,"
  1. . S DGFDA(26.14,DGIENS,.01)=DGFLD("ASSIGN")
  1. . S DGFDA(26.14,DGIENS,.02)=DGFLD("ASSIGNDT")
  1. . S DGFDA(26.14,DGIENS,.03)=DGFLD("ACTION")
  1. . S DGFDA(26.14,DGIENS,.04)=DGFLD("ENTERBY")
  1. . S DGFDA(26.14,DGIENS,.05)=DGFLD("APPRVBY")
  1. . S DGFDA(26.14,DGIENS,.06)=DGFLD("TIULINK")
  1. . ;patch 1005 - allow for the case of no comments
  1. . I $D(DGFLD("COMMENT")) S DGFDA(26.14,DGIENS,1)=$NA(DGFLD("COMMENT"))
  1. . 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.
  1. . ; add in DBRS data to DGFDA
  1. . I $D(DGFLD("DBRS")) D Q:$D(DGERR)
  1. . . D STOHIST^DGPFUT6(DGIENS,.DGFLD,.DGFDA,.DGERR)
  1. . . I $D(DGERR) S DGIEN=0
  1. . . Q
  1. . ;
  1. . ;determine if update or file should be called
  1. . S UPD=(DGIENS["+") I 'UPD D
  1. . . N I,J
  1. . . S I=0 F J=0:0 S I=$O(DGFDA(26.142,I)) Q:I="" I I["+" S UPD=1 Q
  1. . . Q
  1. . ;
  1. . I 'UPD D
  1. . . N DGERR,DIERR
  1. . . D FILE^DIE("","DGFDA","DGERR")
  1. . . I $D(DGERR) S DGIEN=0
  1. . . Q
  1. . E D
  1. . . N DGERR,DGFDAIEN,DIERR
  1. . . S DGFDAIEN=""
  1. . . I DGIENS="+1," S DGFDAIEN="DGFDAIEN",DGFDAIEN(1)=""
  1. . . D UPDATE^DIE("","DGFDA",DGFDAIEN,"DGERR")
  1. . . I $D(DGERR) S DGIEN=0 Q
  1. . . I DGIENS="+1," S DGIEN=+$G(DGFDAIEN(1))
  1. . . Q
  1. . Q
  1. Q $S($G(DGIEN)>0:DGIEN,1:0)
  1. ;
  1. GETDBRS ; called from GETHIST
  1. ; expects DGFLDS() to contain GETS^DIQ(26.14) with all fields "**"
  1. ; Return sorted by DBRS#:
  1. ; DGPFAH("DBRS",inc) = p1^p2^p3^p4^p5
  1. ; p1=DBRS# p2=Other p3=date_int;ext p4=status_int;ext
  1. ; p5=site_int;ext
  1. ;
  1. N I,J,X,Y,DBNM,IENS,TMP
  1. S IENS=0 F S IENS=$O(DGFLDS(26.142,IENS)) Q:'IENS D
  1. . N ARR M ARR=DGFLDS(26.142,IENS)
  1. . S (X,DBNM)=$G(ARR(.01,"E")) Q:X=""
  1. . S $P(X,U,2)=$G(ARR(.02,"E"))
  1. . S $P(X,U,3)=$G(ARR(.03,"I"))_";"_$P($G(ARR(.03,"E")),":",1,2)
  1. . S $P(X,U,4)=$G(ARR(.04,"I"))_";"_$G(ARR(.04,"E"))
  1. . S $P(X,U,5)=$G(ARR(.05,"I"))_";"_$G(ARR(.05,"E"))
  1. . S TMP(DBNM,+IENS)=X
  1. . Q
  1. S X="TMP" F J=1:1 S X=$Q(@X) Q:X="" S DGPFAH("DBRS",J)=@X
  1. Q