- 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 Jan 18, 2025@03:49:35 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