Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DGPFALF

DGPFALF.m

Go to the documentation of this file.
  1. DGPFALF ;ALB/KCL,RBS - PRF LOCAL FLAG API'S ; 4/8/04 4:03pm
  1. ;;5.3;Registration;**425,554**;Aug 13, 1993
  1. ;
  1. ;- no direct entry
  1. QUIT
  1. ;
  1. 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
  1. ;file and returns it in an array format.
  1. ;
  1. ; Input:
  1. ; DGPFIEN - (required) pointer to local flag record in the
  1. ; PRF LOCAL FLAG (#26.11) file
  1. ; DGPFLF - (required) result array passed by reference
  1. ;
  1. ; Output:
  1. ; Function Value - returns 1 on success, 0 on failure
  1. ; DGPFLF - output array containing local flag record field
  1. ; values.
  1. ; Subscript Field# Data
  1. ; -------------- ------- -------------------
  1. ; "FLAG" .01 internal^external
  1. ; "STAT" .02 internal^external
  1. ; "TYPE" .03 internal^external
  1. ; "REVFREQ" .04 internal^external
  1. ; "NOTIDAYS" .05 internal^external
  1. ; "REVGRP" .06 internal^external
  1. ; "TIUTITLE" .07 internal^external
  1. ; "DESC",line#,0 1 character string
  1. ; "PRININV",line#,0 2 character string
  1. ;
  1. N DGIENS ;IEN string for DIQ
  1. N DGFLDS ;results array for DIQ
  1. N DGERR ;error arrary for DIQ
  1. N DGSUB ;pincipal investigator multiple subscript
  1. N RESULT ;return function value
  1. ;
  1. S RESULT=0
  1. ;
  1. I $G(DGPFIEN)>0,$D(^DGPF(26.11,DGPFIEN)) D
  1. . S DGIENS=DGPFIEN_","
  1. . D GETS^DIQ(26.11,DGIENS,"**","IEZ","DGFLDS","DGERR")
  1. . Q:$D(DGERR)
  1. . ;
  1. . ;-- build local flag array
  1. . S DGPFLF("FLAG")=$G(DGFLDS(26.11,DGIENS,.01,"I"))_U_$G(DGFLDS(26.11,DGIENS,.01,"E"))
  1. . S DGPFLF("STAT")=$G(DGFLDS(26.11,DGIENS,.02,"I"))_U_$G(DGFLDS(26.11,DGIENS,.02,"E"))
  1. . S DGPFLF("TYPE")=$G(DGFLDS(26.11,DGIENS,.03,"I"))_U_$G(DGFLDS(26.11,DGIENS,.03,"E"))
  1. . S DGPFLF("REVFREQ")=$G(DGFLDS(26.11,DGIENS,.04,"I"))_U_$G(DGFLDS(26.11,DGIENS,.04,"E"))
  1. . S DGPFLF("NOTIDAYS")=$G(DGFLDS(26.11,DGIENS,.05,"I"))_U_$G(DGFLDS(26.11,DGIENS,.05,"E"))
  1. . S DGPFLF("REVGRP")=$G(DGFLDS(26.11,DGIENS,.06,"I"))_U_$G(DGFLDS(26.11,DGIENS,.06,"E"))
  1. . S DGPFLF("TIUTITLE")=$G(DGFLDS(26.11,DGIENS,.07,"I"))_U_$G(DGFLDS(26.11,DGIENS,.07,"E"))
  1. . ;-- flag description word processing array
  1. . M DGPFLF("DESC")=DGFLDS(26.11,DGIENS,1)
  1. . K DGPFLF("DESC","E"),DGPFLF("DESC","I")
  1. . ;-- principal investigator(s) multiple
  1. . S DGSUB="" F S DGSUB=$O(DGFLDS(26.112,DGSUB)) Q:DGSUB="" D
  1. . . S DGPFLF("PRININV",+DGSUB,0)=$G(DGFLDS(26.112,DGSUB,.01,"I"))_U_$G(DGFLDS(26.112,DGSUB,.01,"E"))
  1. . ;
  1. . S RESULT=1
  1. ;
  1. Q RESULT
  1. ;
  1. FNDFLAG(DGPFFLG) ;Find Flag Name IEN
  1. ; This function finds a flag record IEN using the name field.
  1. ; Input:
  1. ; DGPFFLG - Flag Name field (.01) value
  1. ;
  1. ; Output:
  1. ; Function Value - Returns IEN of existing record on success, 0 on
  1. ; failure
  1. N DGIEN
  1. I $G(DGPFFLG)["" D
  1. . S DGIEN=$O(^DGPF(26.11,"B",DGPFFLG,0))
  1. ;
  1. Q $S($G(DGIEN)>0:DGIEN,1:0)
  1. ;
  1. STOFLAG(DGPFLF,DGPFERR) ;store a single PRF LOCAL FLAG (#26.11) file record
  1. ;
  1. ; Input:
  1. ; DGPFLF - (required) array of values to be filed (see GETLF tag
  1. ; above for valid array structure)
  1. ; DGPFERR - (optional) passed by reference to contain error messages
  1. ;
  1. ; Output:
  1. ; Function Value - Returns IEN of record on success, 0 on failure
  1. ; DGPFERR - Undefined on success, error message on failure
  1. ;
  1. N DGSUB,DGFLD,DGIEN,DGIENS,DGFDA,DGFDAIEN,DGERR
  1. ;
  1. F DGSUB="FLAG","STAT","TYPE","REVFREQ","NOTIDAYS","REVGRP","TIUTITLE" D
  1. . S DGFLD(DGSUB)=$P($G(DGPFLF(DGSUB)),U)
  1. I $D(DGPFLF("DESC")) M DGFLD("DESC")=DGPFLF("DESC")
  1. I $D(DGPFLF("PRININV")) M DGFLD("PRININV")=DGPFLF("PRININV")
  1. I $$VALID^DGPFUT("DGPFALF1",26.11,.DGFLD,.DGPFERR) D
  1. . ;
  1. . ;if name change lookup on original name, otherwise lookup on new name
  1. . S DGIEN=$$FNDFLAG^DGPFALF($S($G(DGPFLF("OLDFLAG"))]"":DGPFLF("OLDFLAG"),1:DGFLD("FLAG")))
  1. . ;the "?+" on an existing record will do LAYGO to lookup and add new
  1. . ; entries. This was needed for adding another entry to the
  1. . ; Principal Investigator(s) multiple (#26.112)
  1. . I DGIEN S DGIENS=DGIEN_"," ;EDIT existing record
  1. . E S DGIENS="+1," ;ADD new record
  1. . S DGFDA(26.11,DGIENS,.01)=DGFLD("FLAG")
  1. . S DGFDA(26.11,DGIENS,.02)=DGFLD("STAT")
  1. . S DGFDA(26.11,DGIENS,.03)=DGFLD("TYPE")
  1. . S DGFDA(26.11,DGIENS,.04)=DGFLD("REVFREQ")
  1. . S DGFDA(26.11,DGIENS,.05)=DGFLD("NOTIDAYS")
  1. . S DGFDA(26.11,DGIENS,.06)=DGFLD("REVGRP")
  1. . S DGFDA(26.11,DGIENS,.07)=DGFLD("TIUTITLE")
  1. . S DGFDA(26.11,DGIENS,1)="DGFLD(""DESC"")"
  1. . ;-- principal investigator(s) multiple
  1. . I $D(DGFLD("PRININV")) D PRININV(+DGIEN,.DGFDA)
  1. . ;
  1. . D UPDATE^DIE("","DGFDA","DGFDAIEN","DGERR")
  1. . I '$D(DGERR),'DGIEN S DGIEN=$G(DGFDAIEN(1))
  1. ;
  1. Q $S($G(DGIEN)>0:DGIEN,1:0)
  1. ;
  1. PRININV(DGPFIEN,DGFDA) ; setup principal investigator(s) multiple (#26.112)
  1. ; Input:
  1. ; DGPFIEN - value will indicate to EDIT or ADD a New Record
  1. ; IEN# = IEN of existing entry - Edit to existing Record
  1. ; 0 = Add New Record
  1. ; DGFDA - array used by FileMan (passed by reference)
  1. ;
  1. ; Output:
  1. ; DGFDA array subscript entries for "PRININV"
  1. ;
  1. ; The DGFDA FDA_ROOT array needs the "?+" on an existing IEN so
  1. ; that FileMan will do LAYGO to lookup and add new entires.
  1. ; This was needed for adding another entry to an existing
  1. ; Principal Investigator(s) multiple (#26.112) field.
  1. ;
  1. S DGPFIEN=+$G(DGPFIEN)
  1. N DGSUB,DGIENS
  1. ;
  1. S DGSUB=0 F S DGSUB=$O(DGFLD("PRININV",DGSUB)) Q:DGSUB="" D
  1. . I DGPFIEN D ;existing record
  1. . . S DGIENS=DGSUB_","_DGPFIEN_"," ;delete
  1. . . Q:DGFLD("PRININV",DGSUB,0)="@"
  1. . . S DGIENS="?+"_DGIENS ;non-delete uses LAYGO
  1. . E S DGIENS="+"_(DGSUB+1)_",+1," ;new record
  1. . ;
  1. . S DGFDA(26.112,DGIENS,.01)=$P(DGFLD("PRININV",DGSUB,0),U)
  1. ;
  1. Q