DGPFDIV1 ;ALB/KCL - PRF ENABLE MEDICAL CENTER DIVISIONS CONT.; 5/07/05 ; 8/25/05 4:12pm
;;5.3;Registration;**650**;Aug 13, 1993;Build 3
;
;No direct entry
QUIT
;
LOCK(DGIEN) ;lock MEDICAL CENTER DIVISION record
;This lock function is used to prevent another process from editing
;a record in the MEDICAL CENTER DIVISION (#40.8) file.
;
; Input:
; DGIEN - (required) IEN for MEDICAL CENTER DIVISION (#40.8) file
;
; Output:
; Function value - returns 1 on success, 0 on failure
;
I $G(DGIEN) L +^DG(40.8,DGIEN):10
;
Q $T
;
UNLOCK(DGIEN) ;unlock MEDICAL CENTER DIVISION record
;This procedure is used to release a lock created by $$LOCK.
;
; Input:
; DGIEN - (required) IEN for MEDICAL CENTER DIVISION (#40.8) file
;
; Output: none
;
I $G(DGIEN) L -^DG(40.8,DGIEN)
;
Q
;
GETDIV(DGIEN,DGDIV) ;retrieve PRF MEDICAL CENTER DIVISION object
;This function is used to retrieve the data fields related to the
;PRF Ownership Indicator from the MEDICAL CENTER DIVISION (#40.8) file
;and place them in a local array.
;
; Input:
; DGIEN - (required) ien for MEDICAL CENTER DIVISION (#40.8) file
;
; Output:
; Function value - returns 1 on success, 0 on failure
; DGDIV - local array of MEDICAL CENTER DIVISION data fields (passed
; by reference)
; Subscript Field#
; ---------- ------
; "NAME" .01
; "INST" .07
; "IND" 26.01
; "EDITDT" 26.02
; "EDITBY" 26.03
;
N DGIENS ;ien string
N DGFLDS ;target root
N DGERR ;error root
N DGRSLT ;function result
;
K DGDIV S DGDIV=""
S DGRSLT=0
;
I $G(DGIEN)>0,$D(^DG(40.8,DGIEN)) D
. S DGIENS=DGIEN_","
. D GETS^DIQ(40.8,DGIENS,".01;.07;26.01;26.02;26.03","IE","DGFLDS","DGERR")
. Q:$D(DGERR)
. ;
. S DGDIV("NAME")=$G(DGFLDS(40.8,DGIENS,.01,"I"))_U_$G(DGFLDS(40.8,DGIENS,.01,"E"))
. S DGDIV("INST")=$G(DGFLDS(40.8,DGIENS,.07,"I"))_U_$G(DGFLDS(40.8,DGIENS,.07,"E"))
. S DGDIV("IND")=$G(DGFLDS(40.8,DGIENS,26.01,"I"))_U_$G(DGFLDS(40.8,DGIENS,26.01,"E"))
. S DGDIV("EDITDT")=$G(DGFLDS(40.8,DGIENS,26.02,"I"))_U_$G(DGFLDS(40.8,DGIENS,26.02,"E"))
. S DGDIV("EDITBY")=$G(DGFLDS(40.8,DGIENS,26.03,"I"))_U_$G(DGFLDS(40.8,DGIENS,26.03,"E"))
. ;
. ;success
. S DGRSLT=1
;
Q DGRSLT
;
STODIV(DGIEN,DGIND) ;store PRF MEDICAL CENTER DIVISION object
;This function is used to store the data fields related to the
;PRF Ownership Indicator into the MEDICAL CENTER DIVISION (#40.8) file.
;
; Input:
; DGIEN - (required) ien for MEDICAL CENTER DIVISION (#40.8) file
; DGIND - (required) PRF Ownership Indicator [1=enable, 0=disable]
;
; Output:
; Function value - returns 1 on success, 0 on failure
;
;
N DGERR ;error root
N DGFDA ;fda array
N DGRSLT ;function result
;
S DGRSLT=0
;
I $G(DGIEN)>0,$D(^DG(40.8,DGIEN)) D
. ;
. ;quit if can't convert internal value to external
. Q:$$EXTERNAL^DILFD(40.8,26.01,"",DGIND)']""
. ;
. ;file data
. S DGFDA(40.8,DGIEN_",",26.01)=DGIND ;indicator
. S DGFDA(40.8,DGIEN_",",26.02)=$$NOW^XLFDT() ;current date/time
. S DGFDA(40.8,DGIEN_",",26.03)=DUZ ;user
. D FILE^DIE("","DGFDA","DGERR")
. Q:$D(DGERR)
. ;
. ;success
. S DGRSLT=1
;
Q DGRSLT
;
VIEW ;view medical center divisions
;This procedure is used to view all medical center divisions within the
;Medical Center Division (#40.8) file and whether or not they have been
;enabled for PRF assignment ownership.
;
; Input: none
; Output: none
;
N DGEXIT ;exit var
N DGIEN ;file (#40.8) ien
N DGINST ;ptr to INSTITUTION file
N DGLINE ;display line
N DGOBJ ;med center division object array
N DGSUB ;loop subscript
;
S $P(DGLINE,"_",66)=""
W @IOF
;
F DGIEN=0:0 S DGIEN=$O(^DG(40.8,DGIEN)) D Q:'DGIEN!($G(DGEXIT))
. K DGOBJ
. I $$GETDIV(DGIEN,.DGOBJ) D
. . F DGSUB="NAME","IND","EDITBY","EDITDT" D
. . . I $P(DGOBJ(DGSUB),U,2)']"" S $P(DGOBJ(DGSUB),U,2)="n/a"
. . ;
. . S:$P(DGOBJ("IND"),U,2)="n/a" $P(DGOBJ("IND"),U,2)="DISABLED (default)"
. . S DGINST=+$P($G(^DG(40.8,DGIEN,0)),U,7)
. . S DGOBJ("ACTIVE")=$S($D(^DGPF(26.13,"AOWN",DGINST,1)):"YES",1:"NO")
. . ;
. . W !," Medical Center Division: ",$P(DGOBJ("NAME"),U,2)
. . W !," PRF Assignment Ownership: ",$P(DGOBJ("IND"),U,2)
. . W !," Edited By: ",$P(DGOBJ("EDITBY"),U,2)
. . W !," Edit Date/Time: ",$P(DGOBJ("EDITDT"),U,2)
. . W !," Active PRF Assignments: ",DGOBJ("ACTIVE")
. . W !,DGLINE,!
. . I $Y>(IOSL-5) S DGEXIT='$$CONTINUE^DGPFUT() W @IOF
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPFDIV1 4679 printed Apr 09, 2024@21:42:52 Page 2
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
+2 ;
+3 ;No direct entry
+4 QUIT
+5 ;
LOCK(DGIEN) ;lock MEDICAL CENTER DIVISION record
+1 ;This lock function is used to prevent another process from editing
+2 ;a record in the MEDICAL CENTER DIVISION (#40.8) file.
+3 ;
+4 ; Input:
+5 ; DGIEN - (required) IEN for MEDICAL CENTER DIVISION (#40.8) file
+6 ;
+7 ; Output:
+8 ; Function value - returns 1 on success, 0 on failure
+9 ;
+10 IF $GET(DGIEN)
LOCK +^DG(40.8,DGIEN):10
+11 ;
+12 QUIT $TEST
+13 ;
UNLOCK(DGIEN) ;unlock MEDICAL CENTER DIVISION record
+1 ;This procedure is used to release a lock created by $$LOCK.
+2 ;
+3 ; Input:
+4 ; DGIEN - (required) IEN for MEDICAL CENTER DIVISION (#40.8) file
+5 ;
+6 ; Output: none
+7 ;
+8 IF $GET(DGIEN)
LOCK -^DG(40.8,DGIEN)
+9 ;
+10 QUIT
+11 ;
GETDIV(DGIEN,DGDIV) ;retrieve PRF MEDICAL CENTER DIVISION object
+1 ;This function is used to retrieve the data fields related to the
+2 ;PRF Ownership Indicator from the MEDICAL CENTER DIVISION (#40.8) file
+3 ;and place them in a local array.
+4 ;
+5 ; Input:
+6 ; DGIEN - (required) ien for MEDICAL CENTER DIVISION (#40.8) file
+7 ;
+8 ; Output:
+9 ; Function value - returns 1 on success, 0 on failure
+10 ; DGDIV - local array of MEDICAL CENTER DIVISION data fields (passed
+11 ; by reference)
+12 ; Subscript Field#
+13 ; ---------- ------
+14 ; "NAME" .01
+15 ; "INST" .07
+16 ; "IND" 26.01
+17 ; "EDITDT" 26.02
+18 ; "EDITBY" 26.03
+19 ;
+20 ;ien string
NEW DGIENS
+21 ;target root
NEW DGFLDS
+22 ;error root
NEW DGERR
+23 ;function result
NEW DGRSLT
+24 ;
+25 KILL DGDIV
SET DGDIV=""
+26 SET DGRSLT=0
+27 ;
+28 IF $GET(DGIEN)>0
IF $DATA(^DG(40.8,DGIEN))
Begin DoDot:1
+29 SET DGIENS=DGIEN_","
+30 DO GETS^DIQ(40.8,DGIENS,".01;.07;26.01;26.02;26.03","IE","DGFLDS","DGERR")
+31 if $DATA(DGERR)
QUIT
+32 ;
+33 SET DGDIV("NAME")=$GET(DGFLDS(40.8,DGIENS,.01,"I"))_U_$GET(DGFLDS(40.8,DGIENS,.01,"E"))
+34 SET DGDIV("INST")=$GET(DGFLDS(40.8,DGIENS,.07,"I"))_U_$GET(DGFLDS(40.8,DGIENS,.07,"E"))
+35 SET DGDIV("IND")=$GET(DGFLDS(40.8,DGIENS,26.01,"I"))_U_$GET(DGFLDS(40.8,DGIENS,26.01,"E"))
+36 SET DGDIV("EDITDT")=$GET(DGFLDS(40.8,DGIENS,26.02,"I"))_U_$GET(DGFLDS(40.8,DGIENS,26.02,"E"))
+37 SET DGDIV("EDITBY")=$GET(DGFLDS(40.8,DGIENS,26.03,"I"))_U_$GET(DGFLDS(40.8,DGIENS,26.03,"E"))
+38 ;
+39 ;success
+40 SET DGRSLT=1
End DoDot:1
+41 ;
+42 QUIT DGRSLT
+43 ;
STODIV(DGIEN,DGIND) ;store PRF MEDICAL CENTER DIVISION object
+1 ;This function is used to store the data fields related to the
+2 ;PRF Ownership Indicator into the MEDICAL CENTER DIVISION (#40.8) file.
+3 ;
+4 ; Input:
+5 ; DGIEN - (required) ien for MEDICAL CENTER DIVISION (#40.8) file
+6 ; DGIND - (required) PRF Ownership Indicator [1=enable, 0=disable]
+7 ;
+8 ; Output:
+9 ; Function value - returns 1 on success, 0 on failure
+10 ;
+11 ;
+12 ;error root
NEW DGERR
+13 ;fda array
NEW DGFDA
+14 ;function result
NEW DGRSLT
+15 ;
+16 SET DGRSLT=0
+17 ;
+18 IF $GET(DGIEN)>0
IF $DATA(^DG(40.8,DGIEN))
Begin DoDot:1
+19 ;
+20 ;quit if can't convert internal value to external
+21 if $$EXTERNAL^DILFD(40.8,26.01,"",DGIND)']""
QUIT
+22 ;
+23 ;file data
+24 ;indicator
SET DGFDA(40.8,DGIEN_",",26.01)=DGIND
+25 ;current date/time
SET DGFDA(40.8,DGIEN_",",26.02)=$$NOW^XLFDT()
+26 ;user
SET DGFDA(40.8,DGIEN_",",26.03)=DUZ
+27 DO FILE^DIE("","DGFDA","DGERR")
+28 if $DATA(DGERR)
QUIT
+29 ;
+30 ;success
+31 SET DGRSLT=1
End DoDot:1
+32 ;
+33 QUIT DGRSLT
+34 ;
VIEW ;view medical center divisions
+1 ;This procedure is used to view all medical center divisions within the
+2 ;Medical Center Division (#40.8) file and whether or not they have been
+3 ;enabled for PRF assignment ownership.
+4 ;
+5 ; Input: none
+6 ; Output: none
+7 ;
+8 ;exit var
NEW DGEXIT
+9 ;file (#40.8) ien
NEW DGIEN
+10 ;ptr to INSTITUTION file
NEW DGINST
+11 ;display line
NEW DGLINE
+12 ;med center division object array
NEW DGOBJ
+13 ;loop subscript
NEW DGSUB
+14 ;
+15 SET $PIECE(DGLINE,"_",66)=""
+16 WRITE @IOF
+17 ;
+18 FOR DGIEN=0:0
SET DGIEN=$ORDER(^DG(40.8,DGIEN))
Begin DoDot:1
+19 KILL DGOBJ
+20 IF $$GETDIV(DGIEN,.DGOBJ)
Begin DoDot:2
+21 FOR DGSUB="NAME","IND","EDITBY","EDITDT"
Begin DoDot:3
+22 IF $PIECE(DGOBJ(DGSUB),U,2)']""
SET $PIECE(DGOBJ(DGSUB),U,2)="n/a"
End DoDot:3
+23 ;
+24 if $PIECE(DGOBJ("IND"),U,2)="n/a"
SET $PIECE(DGOBJ("IND"),U,2)="DISABLED (default)"
+25 SET DGINST=+$PIECE($GET(^DG(40.8,DGIEN,0)),U,7)
+26 SET DGOBJ("ACTIVE")=$SELECT($DATA(^DGPF(26.13,"AOWN",DGINST,1)):"YES",1:"NO")
+27 ;
+28 WRITE !," Medical Center Division: ",$PIECE(DGOBJ("NAME"),U,2)
+29 WRITE !," PRF Assignment Ownership: ",$PIECE(DGOBJ("IND"),U,2)
+30 WRITE !," Edited By: ",$PIECE(DGOBJ("EDITBY"),U,2)
+31 WRITE !," Edit Date/Time: ",$PIECE(DGOBJ("EDITDT"),U,2)
+32 WRITE !," Active PRF Assignments: ",DGOBJ("ACTIVE")
+33 WRITE !,DGLINE,!
+34 IF $Y>(IOSL-5)
SET DGEXIT='$$CONTINUE^DGPFUT()
WRITE @IOF
End DoDot:2
End DoDot:1
if 'DGIEN!($GET(DGEXIT))
QUIT
+35 ;
+36 QUIT
