- 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 Jan 18, 2025@03:48:17 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