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

DGPFDD.m

Go to the documentation of this file.
  1. DGPFDD ;ALB/RPM - PRF DATA DICTIONARY UTILITIES ; 9/06/06 1:14pm
  1. ;;5.3;Registration;**425,554,650,1113**;Aug 13, 1993;Build 10
  1. ;
  1. Q ;No direct entry
  1. ;
  1. INACT(DGIEN,DGSTAT,DGFILE,DGUSER) ;Inactivate flag trigger
  1. ; This procedure is used as a trigger that is fired when the
  1. ; STATUS (#.02) field of a record in either the PRF LOCAL FLAG (#26.11)
  1. ; file or PRF NATIONAL FLAG (#26.15) file is changed from Active to
  1. ; Inactive. The trigger will inactivate all Patient Record
  1. ; Flag assignments associated with the inactivated Flag.
  1. ;
  1. ; Input:
  1. ; DGIEN - IEN of entry in PRF LOCAL FLAG file or PRF NATIONAL
  1. ; FLAG file
  1. ; DGSTAT - Flag Status
  1. ; DGFILE - PRF LOCAL FLAG file number (26.11) or PRF NATIONAL
  1. ; FLAG file number (26.15)
  1. ; DGUSER - IEN of user in NEW PERSON file
  1. ;
  1. ; Output: none
  1. ;
  1. N DGAIEN ;assignment record IEN
  1. N DGSUB ;variable ptr index subscript
  1. ;
  1. Q:('$G(DGIEN))
  1. Q:($G(DGSTAT)'=0)
  1. Q:(($G(DGFILE)'=26.11)&($G(DGFILE)'=26.15))
  1. Q:('$G(DGUSER))
  1. ;
  1. S DGSUB=DGIEN_";DGPF("_DGFILE_","
  1. S DGAIEN=0
  1. F S DGAIEN=$O(^DGPF(26.13,"ASTAT",1,DGSUB,DGAIEN)) Q:'DGAIEN D
  1. . N DGPFA ;assignment data array
  1. . N DGPFAH ;assignment history data array
  1. . I $$GETASGN^DGPFAA(DGAIEN,.DGPFA) D
  1. . . Q:($P($G(DGPFA("STATUS")),U,1)=0)
  1. . . S DGPFA("STATUS")=0
  1. . . S DGPFA("REVIEWDT")=""
  1. . . S DGPFAH("ACTION")=3
  1. . . S DGPFAH("ASSIGNDT")=$$NOW^XLFDT()
  1. . . S DGPFAH("ENTERBY")=DGUSER
  1. . . S DGPFAH("APPRVBY")=DGUSER
  1. . . S DGPFAH("ORIGFAC")=+$$SITE^VASITE
  1. . . S DGPFAH("COMMENT",1,0)="Assignment Inactivated automatically due to Flag Inactivation."
  1. . . I $$STOALL^DGPFAA(.DGPFA,.DGPFAH)
  1. Q
  1. ;
  1. PIHELP ;Executable help for PRINCIPAL INVESTIGATOR(S) (#.01) sub-field of
  1. ;PRINCIPLE INVESTIGATOR(S) (#2) multiple field of PRF LOCAL FLAG
  1. ;(#26.11) file.
  1. ;
  1. ;This sub-routine displays individuals selected as a principal
  1. ;investigator for a research type patient record flag.
  1. ;
  1. ; Input:
  1. ; DGLKUP - (required) array of principal investigators subscripted
  1. ; by the pointer to the NEW PERSON (#200) file and the
  1. ; pointer to the PRF LOCAL FLAG (#26.11) file.
  1. ; Example: DGLKUP(11744,6)=""
  1. ;
  1. ; Output:
  1. ; none
  1. ;
  1. Q:'$D(DGLKUP)
  1. ;
  1. N DGCNT
  1. N DGIEN
  1. N DGNAMES
  1. ;
  1. S DGIEN=0,DGCNT=0
  1. F S DGIEN=$O(DGLKUP(DGIEN)) Q:'DGIEN D
  1. . S DGCNT=DGCNT+1
  1. . S DGNAMES(DGCNT)=$$EXTERNAL^DILFD(26.112,.01,"F",DGIEN)
  1. S DGNAMES(DGCNT+1)="" ;add a blank line
  1. D EN^DDIOL(.DGNAMES)
  1. Q
  1. ;
  1. COS(DGAPRV) ;transform POSTMASTER to CHIEF OF STAFF
  1. ;This output transform converts the internal field value of .5
  1. ;(POSTMASTER) to CHIEF OF STAFF.
  1. ;
  1. ; Supported DBIA #10060 - This supported DBIA permits FileMan reads
  1. ; on all fields of the NEW PERSON (#200) file.
  1. ;
  1. ; Input:
  1. ; DGAPRV - internal value of PRF ASSIGNMENT HISTORY (#26.14) file
  1. ; APPROVED BY (#.05) field
  1. ;
  1. ; Output:
  1. ; Function Value - Returns "CHIEF OF STAFF" when input value is .5 or
  1. ; external value from NAME (.01) field of the NEW
  1. ; PERSON (#200) file on success.
  1. ; Returns null ("") on failure.
  1. ;
  1. N DGERR
  1. ;
  1. Q:(+$G(DGAPRV)'>0) ""
  1. ;
  1. Q $S(DGAPRV=.5:"CHIEF OF STAFF",1:$$GET1^DIQ(200,DGAPRV_",",.01,"","","DGERR"))
  1. ;
  1. TIULIST(DGTIUIEN) ;DD lookup screen for (#26.11) file (#.07) field
  1. ;Get list of TIU Progress Note Titles for Category II (Local) Flags.
  1. ;This function will assist the DIC("S") lookup screen of allowable
  1. ;TIU Progress Note Titles the user can see and select from.
  1. ;
  1. ; Supported DBIA: #4380 - $$CHKDOC^TIUPRF - TIU API's for PRF
  1. ; #4383 - $$FNDTITLE^DGPFAPI1
  1. ;
  1. ; Input:
  1. ; DGTIUIEN - [Required] IEN of (#8925.1) entry being screened
  1. ;
  1. ; Output:
  1. ; Function Value - Returns 1 on success, 0 on failure
  1. ;
  1. N DGPNLIST ;temporary file name to hold list of titles
  1. N DGRSLT ;function return value
  1. N DGX ;loop var
  1. N DGY ;loop var
  1. ;
  1. Q:DGTIUIEN']"" 0
  1. ;
  1. S DGRSLT=0
  1. ;
  1. ; get list from TIU Progress Note Title API call IA #4380
  1. S DGPNLIST=$NA(^TMP("DGPNLIST",$J))
  1. K @DGPNLIST
  1. ;
  1. ; only get Category II (Local) TIU PN Titles (pass a 2)
  1. I $$GETLIST(2,DGPNLIST) D
  1. . S (DGX,DGY)="" F S DGX=$O(@DGPNLIST@("CAT II",DGX)) Q:DGX="" D
  1. . . S DGY=$G(@DGPNLIST@("CAT II",DGX))
  1. . . ; Need to setup the current assigned progress note title as a
  1. . . ; selectable entry or the ^DIR call won't accept the default
  1. . . ; entry when the user hits the retrun key to go to next prompt.
  1. . . ; Only setup if called by PRF action protocol DGPF EDIT FLAG
  1. . . I $P($G(XQORNOD(0)),U,3)="Edit Record Flag",+DGY=$P($G(DGPFORIG("TIUTITLE")),U) D Q
  1. . . . S @DGPNLIST@(+DGY)=""
  1. . . Q:'DGY
  1. . . I '$$FNDTITLE^DGPFAPI1($P(DGY,U,1)) S @DGPNLIST@(+DGY)=""
  1. ;
  1. I $D(@DGPNLIST@(DGTIUIEN)) S DGRSLT=1
  1. K @DGPNLIST
  1. ;
  1. Q DGRSLT
  1. ;
  1. GETLIST(DGCAT,DGLIST) ;Get list of TIU Progress Note Titles
  1. ; This function is used to retrieve a list of active TIU Progress
  1. ; Note Titles that can be associated with Category I or Category II
  1. ; Record Flags.
  1. ;
  1. ; Supported DBIA: #4380 - $$CHKDOC^TIUPRF - TIU API's for PRF
  1. ;
  1. ; Input: [Required]
  1. ; DGCAT - Category of TIU Progress Note Titles to look for
  1. ; 1:Category I
  1. ; 2:Category II
  1. ; 3:Both Category I and II
  1. ; DGLIST - Closed root reference array name to return values
  1. ;
  1. ; Output:
  1. ; Function Value - returns 1 on success, 0 on failure
  1. ; DGLIST() - Closed Root reference name of returned data
  1. ;
  1. N DGRSLT ;function value
  1. S DGRSLT=0
  1. ;
  1. I $G(DGCAT)>0,DGLIST]"",$$GETLIST^TIUPRF(DGCAT,DGLIST) S DGRSLT=1
  1. ;
  1. Q DGRSLT
  1. ;
  1. EVENT(DGDFN) ;PRF HL7 EVENT trigger
  1. ;This trigger creates an entry in the PRF HL7 EVENT (#26.21) file
  1. ;with an INCOMPLETE status.
  1. ;
  1. ; Input:
  1. ; DGDFN - pointer to patient in PATIENT (#2) file
  1. ;
  1. ; Output: none
  1. ;
  1. N DGASGN
  1. ;
  1. ;validate input parameter
  1. Q:'$G(DGDFN)!('$D(^DPT(+$G(DGDFN),0)))
  1. ;
  1. ;don't record event when file re-indexing
  1. I $D(DIU(0))!($D(DIK)&$D(DIKJ)&$D(DIKLK)&$D(DIKS)&$D(DIN)) Q
  1. ;
  1. ;ICN must be national value
  1. Q:'$$MPIOK^DGPFUT(DGDFN)
  1. ;
  1. ;limit to one event per patient
  1. Q:$$FNDEVNT^DGPFHLL1(DGDFN)
  1. ;
  1. ;don't trigger when Category I PRF assignments exist
  1. Q:$$GETALL^DGPFAA(DGDFN,.DGASGN,"",1)
  1. ;
  1. ;record event
  1. D STOEVNT^DGPFHLL1(DGDFN)
  1. ;
  1. Q
  1. ;
  1. SCRNSEL(DGIEN,DGSEL) ;screen user selection
  1. ;This function checks that the selected action does not equal the
  1. ;current field value.
  1. ;
  1. ; Input:
  1. ; DGIEN - (required) MEDICAL CENTER DIVISION (#40.8) file (IEN)
  1. ;
  1. ; DGSEL - (required) user selected action [1=enable, 0=disable]
  1. ;
  1. ; Output:
  1. ; Function value - returns 1 on success, 0 on failure
  1. ;
  1. N DGERR ;error root
  1. N DGFLD ;field value
  1. N DGRSLT ;function result
  1. ;
  1. S DGRSLT=0
  1. ;
  1. I +$G(DGIEN)>0,($G(DGSEL)]"") D
  1. . ;
  1. . S DGFLD=+$$GET1^DIQ(40.8,DGIEN_",",26.01,"I","","DGERR")
  1. . Q:$D(DGERR)
  1. . Q:(DGFLD=DGSEL)
  1. . ;
  1. . S DGRSLT=1
  1. ;
  1. Q DGRSLT
  1. ;
  1. SCRNDIV(DGIEN,DGSEL) ;division screen
  1. ;This function contains the screen logic for enabling/disabling a
  1. ;medical center division.
  1. ;
  1. ;The function (screen) is called from the following locations:
  1. ; Function: $$ASKDIV^DGPFDIV
  1. ; DD: Screen code for PRF ASSIGNMENT OWNERSHIP (#26.01) field
  1. ; of the MEDICAL CENTER DIVISION (#40.8) file
  1. ;
  1. ;Entries will be screened if:
  1. ; - division is enabled and active assignments are associated with
  1. ; the division
  1. ; - division is not associated with an active institution
  1. ; - division does not have a PARENT association in the
  1. ; INSTITUTION (#4) file
  1. ;
  1. ; Input:
  1. ; DGIEN - (required) MEDICAL CENTER DIVISION (#40.8) file entry (IEN)
  1. ; being screened
  1. ; DGSEL - (required) user selected action [1=enable, 0=disable]
  1. ;
  1. ; Output:
  1. ; Function value - returns 1 on success, 0 on failure
  1. ;
  1. N DGINST ;ptr to INSTITUTION file
  1. N DGRSLT ;function result
  1. ;
  1. S DGRSLT=0
  1. ;
  1. I +$G(DGIEN)>0,($G(DGSEL)]"") D
  1. . ;
  1. . S DGINST=+$P($G(^DG(40.8,DGIEN,0)),U,7)
  1. . I DGSEL=0,($D(^DGPF(26.13,"AOWN",DGINST,1))) Q
  1. . I DGSEL=1,'$$ACTIVE^XUAF4(DGINST) Q
  1. . I DGSEL=1,'$$PARENT^DGPFUT1(DGINST) Q
  1. . ;
  1. . S DGRSLT=1
  1. ;
  1. Q DGRSLT