DGPFANF ;ALB/KCL - PRF NATIONAL FLAG API'S ; 4/7/04 2:09pm
;;5.3;Registration;**425,554**;Aug 13, 1993
;
;- no direct entry
QUIT
;
GETNF(DGPFIEN,DGPFNF) ;retrieve a single NATIONAL FLAG record
;This function returns a single flag record from the PRF NATIONAL FLAG
;file and returns it in an array format.
;
; Input:
; DGPFIEN - (required) pointer to national flag record in the
; PRF NATIONAL FLAG (#26.15) file
; DGPFNF - (required) result array passed by reference
;
; Output:
; Function Value - returns 1 on success, 0 on failure
; DGPFNF - output array containing national flag record field
; values.
; Subscript Field# Data
; -------------- ------- ---------------------
; "FLAG" .01 internal^external
; "STAT" .02 internal^external
; "TYPE" .03 internal^external
; "REVFREQ" .04 internal^external
; "NOTIDAYS" .05 internal^external
; "REVGRP" .06 internal^external
; "TIUTITLE" .07 internal^external
; "DESC",line#,0 1 character string
; "PRININV",line#,0 2 character string
;
N DGIENS ;IEN string for DIQ
N DGFLDS ;results array for DIQ
N DGERR ;error arrary for DIQ
N DGSUB ;pincipal investigator multiple subscript
N RESULT ;return function value
;
S RESULT=0
;
I $G(DGPFIEN)>0,$D(^DGPF(26.15,DGPFIEN)) D
. S DGIENS=DGPFIEN_","
. D GETS^DIQ(26.15,DGIENS,"**","IEZ","DGFLDS","DGERR")
. Q:$D(DGERR)
. ;
. ;-- build national flag array
. S DGPFNF("FLAG")=$G(DGFLDS(26.15,DGIENS,.01,"I"))_U_$G(DGFLDS(26.15,DGIENS,.01,"E"))
. S DGPFNF("STAT")=$G(DGFLDS(26.15,DGIENS,.02,"I"))_U_$G(DGFLDS(26.15,DGIENS,.02,"E"))
. S DGPFNF("TYPE")=$G(DGFLDS(26.15,DGIENS,.03,"I"))_U_$G(DGFLDS(26.15,DGIENS,.03,"E"))
. S DGPFNF("REVFREQ")=$G(DGFLDS(26.15,DGIENS,.04,"I"))_U_$G(DGFLDS(26.15,DGIENS,.04,"E"))
. S DGPFNF("NOTIDAYS")=$G(DGFLDS(26.15,DGIENS,.05,"I"))_U_$G(DGFLDS(26.15,DGIENS,.05,"E"))
. S DGPFNF("REVGRP")=$G(DGFLDS(26.15,DGIENS,.06,"I"))_U_$G(DGFLDS(26.15,DGIENS,.06,"E"))
. S DGPFNF("TIUTITLE")=$G(DGFLDS(26.15,DGIENS,.07,"I"))_U_$G(DGFLDS(26.15,DGIENS,.07,"E"))
. ;-- flag description word processing array
. M DGPFNF("DESC")=DGFLDS(26.15,DGIENS,1)
. K DGPFNF("DESC","E"),DGPFNF("DESC","I")
. ;-- principal investigator(s) multiple
. S DGSUB="" F S DGSUB=$O(DGFLDS(26.152,DGSUB)) Q:DGSUB="" D
. . S DGPFNF("PRININV",+DGSUB,0)=$G(DGFLDS(26.152,DGSUB,.01,"I"))_U_$G(DGFLDS(26.152,DGSUB,.01,"E"))
. ;
. S RESULT=1
;
Q RESULT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPFANF 2863 printed Dec 13, 2024@02:47:24 Page 2
DGPFANF ;ALB/KCL - PRF NATIONAL FLAG API'S ; 4/7/04 2:09pm
+1 ;;5.3;Registration;**425,554**;Aug 13, 1993
+2 ;
+3 ;- no direct entry
+4 QUIT
+5 ;
GETNF(DGPFIEN,DGPFNF) ;retrieve a single NATIONAL FLAG record
+1 ;This function returns a single flag record from the PRF NATIONAL FLAG
+2 ;file and returns it in an array format.
+3 ;
+4 ; Input:
+5 ; DGPFIEN - (required) pointer to national flag record in the
+6 ; PRF NATIONAL FLAG (#26.15) file
+7 ; DGPFNF - (required) result array passed by reference
+8 ;
+9 ; Output:
+10 ; Function Value - returns 1 on success, 0 on failure
+11 ; DGPFNF - output array containing national flag record field
+12 ; values.
+13 ; Subscript Field# Data
+14 ; -------------- ------- ---------------------
+15 ; "FLAG" .01 internal^external
+16 ; "STAT" .02 internal^external
+17 ; "TYPE" .03 internal^external
+18 ; "REVFREQ" .04 internal^external
+19 ; "NOTIDAYS" .05 internal^external
+20 ; "REVGRP" .06 internal^external
+21 ; "TIUTITLE" .07 internal^external
+22 ; "DESC",line#,0 1 character string
+23 ; "PRININV",line#,0 2 character string
+24 ;
+25 ;IEN string for DIQ
NEW DGIENS
+26 ;results array for DIQ
NEW DGFLDS
+27 ;error arrary for DIQ
NEW DGERR
+28 ;pincipal investigator multiple subscript
NEW DGSUB
+29 ;return function value
NEW RESULT
+30 ;
+31 SET RESULT=0
+32 ;
+33 IF $GET(DGPFIEN)>0
IF $DATA(^DGPF(26.15,DGPFIEN))
Begin DoDot:1
+34 SET DGIENS=DGPFIEN_","
+35 DO GETS^DIQ(26.15,DGIENS,"**","IEZ","DGFLDS","DGERR")
+36 if $DATA(DGERR)
QUIT
+37 ;
+38 ;-- build national flag array
+39 SET DGPFNF("FLAG")=$GET(DGFLDS(26.15,DGIENS,.01,"I"))_U_$GET(DGFLDS(26.15,DGIENS,.01,"E"))
+40 SET DGPFNF("STAT")=$GET(DGFLDS(26.15,DGIENS,.02,"I"))_U_$GET(DGFLDS(26.15,DGIENS,.02,"E"))
+41 SET DGPFNF("TYPE")=$GET(DGFLDS(26.15,DGIENS,.03,"I"))_U_$GET(DGFLDS(26.15,DGIENS,.03,"E"))
+42 SET DGPFNF("REVFREQ")=$GET(DGFLDS(26.15,DGIENS,.04,"I"))_U_$GET(DGFLDS(26.15,DGIENS,.04,"E"))
+43 SET DGPFNF("NOTIDAYS")=$GET(DGFLDS(26.15,DGIENS,.05,"I"))_U_$GET(DGFLDS(26.15,DGIENS,.05,"E"))
+44 SET DGPFNF("REVGRP")=$GET(DGFLDS(26.15,DGIENS,.06,"I"))_U_$GET(DGFLDS(26.15,DGIENS,.06,"E"))
+45 SET DGPFNF("TIUTITLE")=$GET(DGFLDS(26.15,DGIENS,.07,"I"))_U_$GET(DGFLDS(26.15,DGIENS,.07,"E"))
+46 ;-- flag description word processing array
+47 MERGE DGPFNF("DESC")=DGFLDS(26.15,DGIENS,1)
+48 KILL DGPFNF("DESC","E"),DGPFNF("DESC","I")
+49 ;-- principal investigator(s) multiple
+50 SET DGSUB=""
FOR
SET DGSUB=$ORDER(DGFLDS(26.152,DGSUB))
if DGSUB=""
QUIT
Begin DoDot:2
+51 SET DGPFNF("PRININV",+DGSUB,0)=$GET(DGFLDS(26.152,DGSUB,.01,"I"))_U_$GET(DGFLDS(26.152,DGSUB,.01,"E"))
End DoDot:2
+52 ;
+53 SET RESULT=1
End DoDot:1
+54 ;
+55 QUIT RESULT
