- 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 Feb 19, 2025@00:13:24 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