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

DGPFDIV1.m

Go to the documentation of this file.
  1. DGPFDIV1 ;ALB/KCL - PRF ENABLE MEDICAL CENTER DIVISIONS CONT.; 5/07/05 ; 8/25/05 4:12pm
  1. ;;5.3;Registration;**650**;Aug 13, 1993;Build 3
  1. ;
  1. ;No direct entry
  1. QUIT
  1. ;
  1. LOCK(DGIEN) ;lock MEDICAL CENTER DIVISION record
  1. ;This lock function is used to prevent another process from editing
  1. ;a record in the MEDICAL CENTER DIVISION (#40.8) file.
  1. ;
  1. ; Input:
  1. ; DGIEN - (required) IEN for MEDICAL CENTER DIVISION (#40.8) file
  1. ;
  1. ; Output:
  1. ; Function value - returns 1 on success, 0 on failure
  1. ;
  1. I $G(DGIEN) L +^DG(40.8,DGIEN):10
  1. ;
  1. Q $T
  1. ;
  1. UNLOCK(DGIEN) ;unlock MEDICAL CENTER DIVISION record
  1. ;This procedure is used to release a lock created by $$LOCK.
  1. ;
  1. ; Input:
  1. ; DGIEN - (required) IEN for MEDICAL CENTER DIVISION (#40.8) file
  1. ;
  1. ; Output: none
  1. ;
  1. I $G(DGIEN) L -^DG(40.8,DGIEN)
  1. ;
  1. Q
  1. ;
  1. GETDIV(DGIEN,DGDIV) ;retrieve PRF MEDICAL CENTER DIVISION object
  1. ;This function is used to retrieve the data fields related to the
  1. ;PRF Ownership Indicator from the MEDICAL CENTER DIVISION (#40.8) file
  1. ;and place them in a local array.
  1. ;
  1. ; Input:
  1. ; DGIEN - (required) ien for MEDICAL CENTER DIVISION (#40.8) file
  1. ;
  1. ; Output:
  1. ; Function value - returns 1 on success, 0 on failure
  1. ; DGDIV - local array of MEDICAL CENTER DIVISION data fields (passed
  1. ; by reference)
  1. ; Subscript Field#
  1. ; ---------- ------
  1. ; "NAME" .01
  1. ; "INST" .07
  1. ; "IND" 26.01
  1. ; "EDITDT" 26.02
  1. ; "EDITBY" 26.03
  1. ;
  1. N DGIENS ;ien string
  1. N DGFLDS ;target root
  1. N DGERR ;error root
  1. N DGRSLT ;function result
  1. ;
  1. K DGDIV S DGDIV=""
  1. S DGRSLT=0
  1. ;
  1. I $G(DGIEN)>0,$D(^DG(40.8,DGIEN)) D
  1. . S DGIENS=DGIEN_","
  1. . D GETS^DIQ(40.8,DGIENS,".01;.07;26.01;26.02;26.03","IE","DGFLDS","DGERR")
  1. . Q:$D(DGERR)
  1. . ;
  1. . S DGDIV("NAME")=$G(DGFLDS(40.8,DGIENS,.01,"I"))_U_$G(DGFLDS(40.8,DGIENS,.01,"E"))
  1. . S DGDIV("INST")=$G(DGFLDS(40.8,DGIENS,.07,"I"))_U_$G(DGFLDS(40.8,DGIENS,.07,"E"))
  1. . S DGDIV("IND")=$G(DGFLDS(40.8,DGIENS,26.01,"I"))_U_$G(DGFLDS(40.8,DGIENS,26.01,"E"))
  1. . S DGDIV("EDITDT")=$G(DGFLDS(40.8,DGIENS,26.02,"I"))_U_$G(DGFLDS(40.8,DGIENS,26.02,"E"))
  1. . S DGDIV("EDITBY")=$G(DGFLDS(40.8,DGIENS,26.03,"I"))_U_$G(DGFLDS(40.8,DGIENS,26.03,"E"))
  1. . ;
  1. . ;success
  1. . S DGRSLT=1
  1. ;
  1. Q DGRSLT
  1. ;
  1. STODIV(DGIEN,DGIND) ;store PRF MEDICAL CENTER DIVISION object
  1. ;This function is used to store the data fields related to the
  1. ;PRF Ownership Indicator into the MEDICAL CENTER DIVISION (#40.8) file.
  1. ;
  1. ; Input:
  1. ; DGIEN - (required) ien for MEDICAL CENTER DIVISION (#40.8) file
  1. ; DGIND - (required) PRF Ownership Indicator [1=enable, 0=disable]
  1. ;
  1. ; Output:
  1. ; Function value - returns 1 on success, 0 on failure
  1. ;
  1. ;
  1. N DGERR ;error root
  1. N DGFDA ;fda array
  1. N DGRSLT ;function result
  1. ;
  1. S DGRSLT=0
  1. ;
  1. I $G(DGIEN)>0,$D(^DG(40.8,DGIEN)) D
  1. . ;
  1. . ;quit if can't convert internal value to external
  1. . Q:$$EXTERNAL^DILFD(40.8,26.01,"",DGIND)']""
  1. . ;
  1. . ;file data
  1. . S DGFDA(40.8,DGIEN_",",26.01)=DGIND ;indicator
  1. . S DGFDA(40.8,DGIEN_",",26.02)=$$NOW^XLFDT() ;current date/time
  1. . S DGFDA(40.8,DGIEN_",",26.03)=DUZ ;user
  1. . D FILE^DIE("","DGFDA","DGERR")
  1. . Q:$D(DGERR)
  1. . ;
  1. . ;success
  1. . S DGRSLT=1
  1. ;
  1. Q DGRSLT
  1. ;
  1. VIEW ;view medical center divisions
  1. ;This procedure is used to view all medical center divisions within the
  1. ;Medical Center Division (#40.8) file and whether or not they have been
  1. ;enabled for PRF assignment ownership.
  1. ;
  1. ; Input: none
  1. ; Output: none
  1. ;
  1. N DGEXIT ;exit var
  1. N DGIEN ;file (#40.8) ien
  1. N DGINST ;ptr to INSTITUTION file
  1. N DGLINE ;display line
  1. N DGOBJ ;med center division object array
  1. N DGSUB ;loop subscript
  1. ;
  1. S $P(DGLINE,"_",66)=""
  1. W @IOF
  1. ;
  1. F DGIEN=0:0 S DGIEN=$O(^DG(40.8,DGIEN)) D Q:'DGIEN!($G(DGEXIT))
  1. . K DGOBJ
  1. . I $$GETDIV(DGIEN,.DGOBJ) D
  1. . . F DGSUB="NAME","IND","EDITBY","EDITDT" D
  1. . . . I $P(DGOBJ(DGSUB),U,2)']"" S $P(DGOBJ(DGSUB),U,2)="n/a"
  1. . . ;
  1. . . S:$P(DGOBJ("IND"),U,2)="n/a" $P(DGOBJ("IND"),U,2)="DISABLED (default)"
  1. . . S DGINST=+$P($G(^DG(40.8,DGIEN,0)),U,7)
  1. . . S DGOBJ("ACTIVE")=$S($D(^DGPF(26.13,"AOWN",DGINST,1)):"YES",1:"NO")
  1. . . ;
  1. . . W !," Medical Center Division: ",$P(DGOBJ("NAME"),U,2)
  1. . . W !," PRF Assignment Ownership: ",$P(DGOBJ("IND"),U,2)
  1. . . W !," Edited By: ",$P(DGOBJ("EDITBY"),U,2)
  1. . . W !," Edit Date/Time: ",$P(DGOBJ("EDITDT"),U,2)
  1. . . W !," Active PRF Assignments: ",DGOBJ("ACTIVE")
  1. . . W !,DGLINE,!
  1. . . I $Y>(IOSL-5) S DGEXIT='$$CONTINUE^DGPFUT() W @IOF
  1. ;
  1. Q