DGPFUT6 ;SHRPE/SGM - PRF DBRS# MAIN DRIVER ; Jan 19, 2018 16:45
;;5.3;Registration;**951**;Aug 13, 1993;Build 135
; Last Edited: SHRPE/sgm - Aug 22, 2018 09:16
;
; ICR# TYPE DESCRIPTION
;----- ---- -----------------------------------------
; 2051 Sup $$FIND1^DIC
; 2056 Sup $$GET1^DIQ
;10112 Sup $$SITE^VASITE
;
;=====================================================================
;*** This routine is the gateway to the other DGPFUT6* routines ***
;*** DGPFUT6 is the only routine authorized to invoke other ***
;*** DGPFUT6* routines. ***
;=====================================================================
;
Q
;
;=====================================================================
AASGN(DGIENS,DGPFA,DGFDA,DGPFUV,DGPFERR) ;
; set up FILE^DIE or UPDATE^DIE input array for DBRS data
D AASGN^DGPFUT62($G(DGIENS),.DGPFA,.DGFDA,$G(DGPFUV),.DGPFERR)
Q
;
;=====================================================================
DBRSEDIT() ; called from AF/EF Listmanager actions
Q $$DBRS^DGPFUT61
;
;=====================================================================
DBRSNO(DGN,DGNIEN) ; validate DBRS# unique in VistA
Q $$DBRSVAL^DGPFUT61($G(DGN),$G(DGNIEN))
;
;=====================================================================
DEFDIV() ; return a valid PRF division for this user
N X
S X=+$G(DUZ(2)) I X,$$ISDIV^DGPFUT(X) Q X
S X=+$$SITE^VASITE
Q X
;
;=====================================================================
DEL(DGXIEN,DGFILE) ; delete DBRS data from FM record
; DGXIEN - ien to file 26.13 OR 26.14
; DGFILE - 26.13 or 26.14
D DEL^DGPFUT62(DGXIEN,DGFILE)
Q
;
EIE(DGPFIN) ; warning message that all DBRS# will be removed
D EIE^DGPFUT61(.DGPFIN)
Q
;
;=====================================================================
FLAG(DGPFIN,SCR,TYPE) ;
; Find one flag matching
; INPUT PARAMETERS:
; DGPFIN - required - flag full name or variable-pointer syntax
; SCR - required - flag name to use as a screen if DGPFIN is
; var-pointer
; TYPE - optional - I or II or <null or 0 - for either>
; EXTRINSIC FUNCTION returns 0 or variable_pointer^flag_name
;
Q $$FLAG^DGPFUT64($G(DGPFIN),$G(SCR),$G(TYPE))
;
;=====================================================================
FLAGCVRT(DGRET,VAL,TYPE) ;
;Convert flag name to variable pointer / variable pointer to flag name
;INPUT PARAMETERS:
; TYPE - optional - I:only return Cat I values
; II:only return Cat II values
; null or 0:return either Cat I or Cat II
; VAL - required - flag full name or variable-pointer syntax
;
;EXTRINSIC FUNCTION and RETURN PARAMETER DGRET returns:
; 0 if no matches or error encountered
; else variable_pointer ^ name of flag
; This expects that there are not multiple flags with the same name
;
D FLAGCVRT^DGPFUT64(.DGRET,$G(VAL),$G(TYPE))
Q:$Q DGRET
Q
;=====================================================================
GETDBRS(DGRET,DGAIEN) ; Get DBRS data for an Assignment record
D GETDBRS^DGPFUT62(.DGRET,$G(DGAIEN))
Q
;
;=====================================================================
GETDBRSH(DGRET,DGHIEN) ; Get DBRS data fOR a History record
D GETDBRSH^DGPFUT62(.DGRET,$G(DGHIEN))
Q
;
;=====================================================================
ICR() ;
; called from ICR entry points
; to not update the ICR agreements affected, DBRS data will not be
; returned from a call that is invoking that ICR agreement unless
; one undertakes the responsibility of upgrading the calling
; program also.
; Return 1 if called from external source via ICR
; 0 if called from DG internal sources
; 0 if external source will use updated info
N X,Y
S Y=1,X=$G(XQY0)
I $E(X,1,2)="DG" S Y=0
I Y,$E(X,1,2)="OR" S Y=0
Q Y
;
;=====================================================================
LOC(DGIN) ; Was History record created locally or at another VAMC
Q $$LOC^DGPFUT63(.DGIN)
;
;=====================================================================
SELASGN(DGSCR,FLG) ;
; select an existing assignment from from 26.13
;INPUT PARAMETER: DGSCR - optional - ^DIC input parameter DIC("S")
; FLG - optional, if Z then return zeroth node as
; second and subsequent "^"-pieces
;EXTRINSIC FUNCTION: ien or ien[^zeroth node] or 0 or -1
;
Q $$SELASGN^DGPFUT64($G(DGSCR),$G(FLG))
;
;=====================================================================
STOHIST(DGIENS,DGFLD,DGFDA,DGPFERR) ;
; File DBRS data for History record
D STOHIST^DGPFUT62(DGIENS,.DGFLD,.DGFDA,.DGPFERR)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPFUT6 4853 printed Oct 16, 2024@18:49:31 Page 2
DGPFUT6 ;SHRPE/SGM - PRF DBRS# MAIN DRIVER ; Jan 19, 2018 16:45
+1 ;;5.3;Registration;**951**;Aug 13, 1993;Build 135
+2 ; Last Edited: SHRPE/sgm - Aug 22, 2018 09:16
+3 ;
+4 ; ICR# TYPE DESCRIPTION
+5 ;----- ---- -----------------------------------------
+6 ; 2051 Sup $$FIND1^DIC
+7 ; 2056 Sup $$GET1^DIQ
+8 ;10112 Sup $$SITE^VASITE
+9 ;
+10 ;=====================================================================
+11 ;*** This routine is the gateway to the other DGPFUT6* routines ***
+12 ;*** DGPFUT6 is the only routine authorized to invoke other ***
+13 ;*** DGPFUT6* routines. ***
+14 ;=====================================================================
+15 ;
+16 QUIT
+17 ;
+18 ;=====================================================================
AASGN(DGIENS,DGPFA,DGFDA,DGPFUV,DGPFERR) ;
+1 ; set up FILE^DIE or UPDATE^DIE input array for DBRS data
+2 DO AASGN^DGPFUT62($GET(DGIENS),.DGPFA,.DGFDA,$GET(DGPFUV),.DGPFERR)
+3 QUIT
+4 ;
+5 ;=====================================================================
DBRSEDIT() ; called from AF/EF Listmanager actions
+1 QUIT $$DBRS^DGPFUT61
+2 ;
+3 ;=====================================================================
DBRSNO(DGN,DGNIEN) ; validate DBRS# unique in VistA
+1 QUIT $$DBRSVAL^DGPFUT61($GET(DGN),$GET(DGNIEN))
+2 ;
+3 ;=====================================================================
DEFDIV() ; return a valid PRF division for this user
+1 NEW X
+2 SET X=+$GET(DUZ(2))
IF X
IF $$ISDIV^DGPFUT(X)
QUIT X
+3 SET X=+$$SITE^VASITE
+4 QUIT X
+5 ;
+6 ;=====================================================================
DEL(DGXIEN,DGFILE) ; delete DBRS data from FM record
+1 ; DGXIEN - ien to file 26.13 OR 26.14
+2 ; DGFILE - 26.13 or 26.14
+3 DO DEL^DGPFUT62(DGXIEN,DGFILE)
+4 QUIT
+5 ;
EIE(DGPFIN) ; warning message that all DBRS# will be removed
+1 DO EIE^DGPFUT61(.DGPFIN)
+2 QUIT
+3 ;
+4 ;=====================================================================
FLAG(DGPFIN,SCR,TYPE) ;
+1 ; Find one flag matching
+2 ; INPUT PARAMETERS:
+3 ; DGPFIN - required - flag full name or variable-pointer syntax
+4 ; SCR - required - flag name to use as a screen if DGPFIN is
+5 ; var-pointer
+6 ; TYPE - optional - I or II or <null or 0 - for either>
+7 ; EXTRINSIC FUNCTION returns 0 or variable_pointer^flag_name
+8 ;
+9 QUIT $$FLAG^DGPFUT64($GET(DGPFIN),$GET(SCR),$GET(TYPE))
+10 ;
+11 ;=====================================================================
FLAGCVRT(DGRET,VAL,TYPE) ;
+1 ;Convert flag name to variable pointer / variable pointer to flag name
+2 ;INPUT PARAMETERS:
+3 ; TYPE - optional - I:only return Cat I values
+4 ; II:only return Cat II values
+5 ; null or 0:return either Cat I or Cat II
+6 ; VAL - required - flag full name or variable-pointer syntax
+7 ;
+8 ;EXTRINSIC FUNCTION and RETURN PARAMETER DGRET returns:
+9 ; 0 if no matches or error encountered
+10 ; else variable_pointer ^ name of flag
+11 ; This expects that there are not multiple flags with the same name
+12 ;
+13 DO FLAGCVRT^DGPFUT64(.DGRET,$GET(VAL),$GET(TYPE))
+14 if $QUIT
QUIT DGRET
+15 QUIT
+16 ;=====================================================================
GETDBRS(DGRET,DGAIEN) ; Get DBRS data for an Assignment record
+1 DO GETDBRS^DGPFUT62(.DGRET,$GET(DGAIEN))
+2 QUIT
+3 ;
+4 ;=====================================================================
GETDBRSH(DGRET,DGHIEN) ; Get DBRS data fOR a History record
+1 DO GETDBRSH^DGPFUT62(.DGRET,$GET(DGHIEN))
+2 QUIT
+3 ;
+4 ;=====================================================================
ICR() ;
+1 ; called from ICR entry points
+2 ; to not update the ICR agreements affected, DBRS data will not be
+3 ; returned from a call that is invoking that ICR agreement unless
+4 ; one undertakes the responsibility of upgrading the calling
+5 ; program also.
+6 ; Return 1 if called from external source via ICR
+7 ; 0 if called from DG internal sources
+8 ; 0 if external source will use updated info
+9 NEW X,Y
+10 SET Y=1
SET X=$GET(XQY0)
+11 IF $EXTRACT(X,1,2)="DG"
SET Y=0
+12 IF Y
IF $EXTRACT(X,1,2)="OR"
SET Y=0
+13 QUIT Y
+14 ;
+15 ;=====================================================================
LOC(DGIN) ; Was History record created locally or at another VAMC
+1 QUIT $$LOC^DGPFUT63(.DGIN)
+2 ;
+3 ;=====================================================================
SELASGN(DGSCR,FLG) ;
+1 ; select an existing assignment from from 26.13
+2 ;INPUT PARAMETER: DGSCR - optional - ^DIC input parameter DIC("S")
+3 ; FLG - optional, if Z then return zeroth node as
+4 ; second and subsequent "^"-pieces
+5 ;EXTRINSIC FUNCTION: ien or ien[^zeroth node] or 0 or -1
+6 ;
+7 QUIT $$SELASGN^DGPFUT64($GET(DGSCR),$GET(FLG))
+8 ;
+9 ;=====================================================================
STOHIST(DGIENS,DGFLD,DGFDA,DGPFERR) ;
+1 ; File DBRS data for History record
+2 DO STOHIST^DGPFUT62(DGIENS,.DGFLD,.DGFDA,.DGPFERR)
+3 QUIT
