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