DGPFALF ;ALB/KCL,RBS - PRF LOCAL FLAG API'S ; 4/8/04 4:03pm
;;5.3;Registration;**425,554**;Aug 13, 1993
;
;- no direct entry
QUIT
;
GETLF(DGPFIEN,DGPFLF) ;retrieve a single PRF LOCAL FLAG (#26.11) record
;This function returns a single flag record from the PRF LOCAL FLAG
;file and returns it in an array format.
;
; Input:
; DGPFIEN - (required) pointer to local flag record in the
; PRF LOCAL FLAG (#26.11) file
; DGPFLF - (required) result array passed by reference
;
; Output:
; Function Value - returns 1 on success, 0 on failure
; DGPFLF - output array containing local 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.11,DGPFIEN)) D
. S DGIENS=DGPFIEN_","
. D GETS^DIQ(26.11,DGIENS,"**","IEZ","DGFLDS","DGERR")
. Q:$D(DGERR)
. ;
. ;-- build local flag array
. S DGPFLF("FLAG")=$G(DGFLDS(26.11,DGIENS,.01,"I"))_U_$G(DGFLDS(26.11,DGIENS,.01,"E"))
. S DGPFLF("STAT")=$G(DGFLDS(26.11,DGIENS,.02,"I"))_U_$G(DGFLDS(26.11,DGIENS,.02,"E"))
. S DGPFLF("TYPE")=$G(DGFLDS(26.11,DGIENS,.03,"I"))_U_$G(DGFLDS(26.11,DGIENS,.03,"E"))
. S DGPFLF("REVFREQ")=$G(DGFLDS(26.11,DGIENS,.04,"I"))_U_$G(DGFLDS(26.11,DGIENS,.04,"E"))
. S DGPFLF("NOTIDAYS")=$G(DGFLDS(26.11,DGIENS,.05,"I"))_U_$G(DGFLDS(26.11,DGIENS,.05,"E"))
. S DGPFLF("REVGRP")=$G(DGFLDS(26.11,DGIENS,.06,"I"))_U_$G(DGFLDS(26.11,DGIENS,.06,"E"))
. S DGPFLF("TIUTITLE")=$G(DGFLDS(26.11,DGIENS,.07,"I"))_U_$G(DGFLDS(26.11,DGIENS,.07,"E"))
. ;-- flag description word processing array
. M DGPFLF("DESC")=DGFLDS(26.11,DGIENS,1)
. K DGPFLF("DESC","E"),DGPFLF("DESC","I")
. ;-- principal investigator(s) multiple
. S DGSUB="" F S DGSUB=$O(DGFLDS(26.112,DGSUB)) Q:DGSUB="" D
. . S DGPFLF("PRININV",+DGSUB,0)=$G(DGFLDS(26.112,DGSUB,.01,"I"))_U_$G(DGFLDS(26.112,DGSUB,.01,"E"))
. ;
. S RESULT=1
;
Q RESULT
;
FNDFLAG(DGPFFLG) ;Find Flag Name IEN
; This function finds a flag record IEN using the name field.
; Input:
; DGPFFLG - Flag Name field (.01) value
;
; Output:
; Function Value - Returns IEN of existing record on success, 0 on
; failure
N DGIEN
I $G(DGPFFLG)["" D
. S DGIEN=$O(^DGPF(26.11,"B",DGPFFLG,0))
;
Q $S($G(DGIEN)>0:DGIEN,1:0)
;
STOFLAG(DGPFLF,DGPFERR) ;store a single PRF LOCAL FLAG (#26.11) file record
;
; Input:
; DGPFLF - (required) array of values to be filed (see GETLF tag
; above for valid array structure)
; DGPFERR - (optional) passed by reference to contain error messages
;
; Output:
; Function Value - Returns IEN of record on success, 0 on failure
; DGPFERR - Undefined on success, error message on failure
;
N DGSUB,DGFLD,DGIEN,DGIENS,DGFDA,DGFDAIEN,DGERR
;
F DGSUB="FLAG","STAT","TYPE","REVFREQ","NOTIDAYS","REVGRP","TIUTITLE" D
. S DGFLD(DGSUB)=$P($G(DGPFLF(DGSUB)),U)
I $D(DGPFLF("DESC")) M DGFLD("DESC")=DGPFLF("DESC")
I $D(DGPFLF("PRININV")) M DGFLD("PRININV")=DGPFLF("PRININV")
I $$VALID^DGPFUT("DGPFALF1",26.11,.DGFLD,.DGPFERR) D
. ;
. ;if name change lookup on original name, otherwise lookup on new name
. S DGIEN=$$FNDFLAG^DGPFALF($S($G(DGPFLF("OLDFLAG"))]"":DGPFLF("OLDFLAG"),1:DGFLD("FLAG")))
. ;the "?+" on an existing record will do LAYGO to lookup and add new
. ; entries. This was needed for adding another entry to the
. ; Principal Investigator(s) multiple (#26.112)
. I DGIEN S DGIENS=DGIEN_"," ;EDIT existing record
. E S DGIENS="+1," ;ADD new record
. S DGFDA(26.11,DGIENS,.01)=DGFLD("FLAG")
. S DGFDA(26.11,DGIENS,.02)=DGFLD("STAT")
. S DGFDA(26.11,DGIENS,.03)=DGFLD("TYPE")
. S DGFDA(26.11,DGIENS,.04)=DGFLD("REVFREQ")
. S DGFDA(26.11,DGIENS,.05)=DGFLD("NOTIDAYS")
. S DGFDA(26.11,DGIENS,.06)=DGFLD("REVGRP")
. S DGFDA(26.11,DGIENS,.07)=DGFLD("TIUTITLE")
. S DGFDA(26.11,DGIENS,1)="DGFLD(""DESC"")"
. ;-- principal investigator(s) multiple
. I $D(DGFLD("PRININV")) D PRININV(+DGIEN,.DGFDA)
. ;
. D UPDATE^DIE("","DGFDA","DGFDAIEN","DGERR")
. I '$D(DGERR),'DGIEN S DGIEN=$G(DGFDAIEN(1))
;
Q $S($G(DGIEN)>0:DGIEN,1:0)
;
PRININV(DGPFIEN,DGFDA) ; setup principal investigator(s) multiple (#26.112)
; Input:
; DGPFIEN - value will indicate to EDIT or ADD a New Record
; IEN# = IEN of existing entry - Edit to existing Record
; 0 = Add New Record
; DGFDA - array used by FileMan (passed by reference)
;
; Output:
; DGFDA array subscript entries for "PRININV"
;
; The DGFDA FDA_ROOT array needs the "?+" on an existing IEN so
; that FileMan will do LAYGO to lookup and add new entires.
; This was needed for adding another entry to an existing
; Principal Investigator(s) multiple (#26.112) field.
;
S DGPFIEN=+$G(DGPFIEN)
N DGSUB,DGIENS
;
S DGSUB=0 F S DGSUB=$O(DGFLD("PRININV",DGSUB)) Q:DGSUB="" D
. I DGPFIEN D ;existing record
. . S DGIENS=DGSUB_","_DGPFIEN_"," ;delete
. . Q:DGFLD("PRININV",DGSUB,0)="@"
. . S DGIENS="?+"_DGIENS ;non-delete uses LAYGO
. E S DGIENS="+"_(DGSUB+1)_",+1," ;new record
. ;
. S DGFDA(26.112,DGIENS,.01)=$P(DGFLD("PRININV",DGSUB,0),U)
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPFALF 6203 printed Dec 13, 2024@02:47:22 Page 2
DGPFALF ;ALB/KCL,RBS - PRF LOCAL FLAG API'S ; 4/8/04 4:03pm
+1 ;;5.3;Registration;**425,554**;Aug 13, 1993
+2 ;
+3 ;- no direct entry
+4 QUIT
+5 ;
GETLF(DGPFIEN,DGPFLF) ;retrieve a single PRF LOCAL FLAG (#26.11) record
+1 ;This function returns a single flag record from the PRF LOCAL FLAG
+2 ;file and returns it in an array format.
+3 ;
+4 ; Input:
+5 ; DGPFIEN - (required) pointer to local flag record in the
+6 ; PRF LOCAL FLAG (#26.11) file
+7 ; DGPFLF - (required) result array passed by reference
+8 ;
+9 ; Output:
+10 ; Function Value - returns 1 on success, 0 on failure
+11 ; DGPFLF - output array containing local 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.11,DGPFIEN))
Begin DoDot:1
+34 SET DGIENS=DGPFIEN_","
+35 DO GETS^DIQ(26.11,DGIENS,"**","IEZ","DGFLDS","DGERR")
+36 if $DATA(DGERR)
QUIT
+37 ;
+38 ;-- build local flag array
+39 SET DGPFLF("FLAG")=$GET(DGFLDS(26.11,DGIENS,.01,"I"))_U_$GET(DGFLDS(26.11,DGIENS,.01,"E"))
+40 SET DGPFLF("STAT")=$GET(DGFLDS(26.11,DGIENS,.02,"I"))_U_$GET(DGFLDS(26.11,DGIENS,.02,"E"))
+41 SET DGPFLF("TYPE")=$GET(DGFLDS(26.11,DGIENS,.03,"I"))_U_$GET(DGFLDS(26.11,DGIENS,.03,"E"))
+42 SET DGPFLF("REVFREQ")=$GET(DGFLDS(26.11,DGIENS,.04,"I"))_U_$GET(DGFLDS(26.11,DGIENS,.04,"E"))
+43 SET DGPFLF("NOTIDAYS")=$GET(DGFLDS(26.11,DGIENS,.05,"I"))_U_$GET(DGFLDS(26.11,DGIENS,.05,"E"))
+44 SET DGPFLF("REVGRP")=$GET(DGFLDS(26.11,DGIENS,.06,"I"))_U_$GET(DGFLDS(26.11,DGIENS,.06,"E"))
+45 SET DGPFLF("TIUTITLE")=$GET(DGFLDS(26.11,DGIENS,.07,"I"))_U_$GET(DGFLDS(26.11,DGIENS,.07,"E"))
+46 ;-- flag description word processing array
+47 MERGE DGPFLF("DESC")=DGFLDS(26.11,DGIENS,1)
+48 KILL DGPFLF("DESC","E"),DGPFLF("DESC","I")
+49 ;-- principal investigator(s) multiple
+50 SET DGSUB=""
FOR
SET DGSUB=$ORDER(DGFLDS(26.112,DGSUB))
if DGSUB=""
QUIT
Begin DoDot:2
+51 SET DGPFLF("PRININV",+DGSUB,0)=$GET(DGFLDS(26.112,DGSUB,.01,"I"))_U_$GET(DGFLDS(26.112,DGSUB,.01,"E"))
End DoDot:2
+52 ;
+53 SET RESULT=1
End DoDot:1
+54 ;
+55 QUIT RESULT
+56 ;
FNDFLAG(DGPFFLG) ;Find Flag Name IEN
+1 ; This function finds a flag record IEN using the name field.
+2 ; Input:
+3 ; DGPFFLG - Flag Name field (.01) value
+4 ;
+5 ; Output:
+6 ; Function Value - Returns IEN of existing record on success, 0 on
+7 ; failure
+8 NEW DGIEN
+9 IF $GET(DGPFFLG)[""
Begin DoDot:1
+10 SET DGIEN=$ORDER(^DGPF(26.11,"B",DGPFFLG,0))
End DoDot:1
+11 ;
+12 QUIT $SELECT($GET(DGIEN)>0:DGIEN,1:0)
+13 ;
STOFLAG(DGPFLF,DGPFERR) ;store a single PRF LOCAL FLAG (#26.11) file record
+1 ;
+2 ; Input:
+3 ; DGPFLF - (required) array of values to be filed (see GETLF tag
+4 ; above for valid array structure)
+5 ; DGPFERR - (optional) passed by reference to contain error messages
+6 ;
+7 ; Output:
+8 ; Function Value - Returns IEN of record on success, 0 on failure
+9 ; DGPFERR - Undefined on success, error message on failure
+10 ;
+11 NEW DGSUB,DGFLD,DGIEN,DGIENS,DGFDA,DGFDAIEN,DGERR
+12 ;
+13 FOR DGSUB="FLAG","STAT","TYPE","REVFREQ","NOTIDAYS","REVGRP","TIUTITLE"
Begin DoDot:1
+14 SET DGFLD(DGSUB)=$PIECE($GET(DGPFLF(DGSUB)),U)
End DoDot:1
+15 IF $DATA(DGPFLF("DESC"))
MERGE DGFLD("DESC")=DGPFLF("DESC")
+16 IF $DATA(DGPFLF("PRININV"))
MERGE DGFLD("PRININV")=DGPFLF("PRININV")
+17 IF $$VALID^DGPFUT("DGPFALF1",26.11,.DGFLD,.DGPFERR)
Begin DoDot:1
+18 ;
+19 ;if name change lookup on original name, otherwise lookup on new name
+20 SET DGIEN=$$FNDFLAG^DGPFALF($SELECT($GET(DGPFLF("OLDFLAG"))]"":DGPFLF("OLDFLAG"),1:DGFLD("FLAG")))
+21 ;the "?+" on an existing record will do LAYGO to lookup and add new
+22 ; entries. This was needed for adding another entry to the
+23 ; Principal Investigator(s) multiple (#26.112)
+24 ;EDIT existing record
IF DGIEN
SET DGIENS=DGIEN_","
+25 ;ADD new record
IF '$TEST
SET DGIENS="+1,"
+26 SET DGFDA(26.11,DGIENS,.01)=DGFLD("FLAG")
+27 SET DGFDA(26.11,DGIENS,.02)=DGFLD("STAT")
+28 SET DGFDA(26.11,DGIENS,.03)=DGFLD("TYPE")
+29 SET DGFDA(26.11,DGIENS,.04)=DGFLD("REVFREQ")
+30 SET DGFDA(26.11,DGIENS,.05)=DGFLD("NOTIDAYS")
+31 SET DGFDA(26.11,DGIENS,.06)=DGFLD("REVGRP")
+32 SET DGFDA(26.11,DGIENS,.07)=DGFLD("TIUTITLE")
+33 SET DGFDA(26.11,DGIENS,1)="DGFLD(""DESC"")"
+34 ;-- principal investigator(s) multiple
+35 IF $DATA(DGFLD("PRININV"))
DO PRININV(+DGIEN,.DGFDA)
+36 ;
+37 DO UPDATE^DIE("","DGFDA","DGFDAIEN","DGERR")
+38 IF '$DATA(DGERR)
IF 'DGIEN
SET DGIEN=$GET(DGFDAIEN(1))
End DoDot:1
+39 ;
+40 QUIT $SELECT($GET(DGIEN)>0:DGIEN,1:0)
+41 ;
PRININV(DGPFIEN,DGFDA) ; setup principal investigator(s) multiple (#26.112)
+1 ; Input:
+2 ; DGPFIEN - value will indicate to EDIT or ADD a New Record
+3 ; IEN# = IEN of existing entry - Edit to existing Record
+4 ; 0 = Add New Record
+5 ; DGFDA - array used by FileMan (passed by reference)
+6 ;
+7 ; Output:
+8 ; DGFDA array subscript entries for "PRININV"
+9 ;
+10 ; The DGFDA FDA_ROOT array needs the "?+" on an existing IEN so
+11 ; that FileMan will do LAYGO to lookup and add new entires.
+12 ; This was needed for adding another entry to an existing
+13 ; Principal Investigator(s) multiple (#26.112) field.
+14 ;
+15 SET DGPFIEN=+$GET(DGPFIEN)
+16 NEW DGSUB,DGIENS
+17 ;
+18 SET DGSUB=0
FOR
SET DGSUB=$ORDER(DGFLD("PRININV",DGSUB))
if DGSUB=""
QUIT
Begin DoDot:1
+19 ;existing record
IF DGPFIEN
Begin DoDot:2
+20 ;delete
SET DGIENS=DGSUB_","_DGPFIEN_","
+21 if DGFLD("PRININV",DGSUB,0)="@"
QUIT
+22 ;non-delete uses LAYGO
SET DGIENS="?+"_DGIENS
End DoDot:2
+23 ;new record
IF '$TEST
SET DGIENS="+"_(DGSUB+1)_",+1,"
+24 ;
+25 SET DGFDA(26.112,DGIENS,.01)=$PIECE(DGFLD("PRININV",DGSUB,0),U)
End DoDot:1
+26 ;
+27 QUIT
