- DGPFDD ;ALB/RPM - PRF DATA DICTIONARY UTILITIES ; 9/06/06 1:14pm
- ;;5.3;Registration;**425,554,650,1113**;Aug 13, 1993;Build 10
- ;
- 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("ORIGFAC")=+$$SITE^VASITE
- . . 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
- . ;
- . S DGRSLT=1
- ;
- Q DGRSLT
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPFDD 8418 printed Feb 19, 2025@00:13:36 Page 2
- 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
- +2 ;
- +3 ;No direct entry
- QUIT
- +4 ;
- 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("ORIGFAC")=+$$SITE^VASITE
- +39 SET DGPFAH("COMMENT",1,0)="Assignment Inactivated automatically due to Flag Inactivation."
- +40 IF $$STOALL^DGPFAA(.DGPFA,.DGPFAH)
- End DoDot:2
- End DoDot:1
- +41 QUIT
- +42 ;
- 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 IF DGSEL=1
- IF '$$PARENT^DGPFUT1(DGINST)
- QUIT
- +35 ;
- +36 SET DGRSLT=1
- End DoDot:1
- +37 ;
- +38 QUIT DGRSLT