Routine: DGPFANF

DGPFANF ;ALB/KCL - PRF NATIONAL FLAG API'S ; 4/7/04 2:09pm

 ;;5.3;Registration;**425,554,1015**;Aug 13, 1993;Build 21

 ;- 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

DGPFANF   ;ALB/KCL - PRF NATIONAL FLAG API'S ; 4/7/04 2:09pm

 +1       ;;5.3;Registration;**425,554,1015**;Aug 13, 1993;Build 21

 +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

DGPFANF.m