DGPFUT1 ;ALB/RBS - PRF UTILITIES CONTINUED ; 6/9/06 10:56am
;;5.3;Registration;**425,607,650**;Aug 13, 1993;Build 3
;
Q ;no direct entry
;
DISPACT(DGPFAPI) ;Display all ACTIVE Patient Record Flag's for a patient
; Input: DGPFAPI() = Array of patients active flags
; (passed by reference)
; See $$GETACT^DGPFAPI for array format.
; Output: None
;
I '$G(DGPFAPI) Q ;no flags
;
N DGPF,DGPFIEN,DGPFFLAG,DGPFCAT,IORVON,IORVOFF
N DGCNT ;flag display count
N DGRET ;return
;
I $D(DDS) D CLRMSG^DDS
W:'$D(DDS) !! W ">>> Active Patient Record Flag(s):"
;
; setup for reverse video display
;
S (IORVON,IORVOFF)=""
D:$D(IOST(0))
. N X S X="IORVON;IORVOFF" D ENDR^%ZISS
;
; loop all returned Active Record Flag Assignment ien's
S DGCNT=0
S DGPFIEN="" F S DGPFIEN=$O(DGPFAPI(DGPFIEN)) Q:DGPFIEN="" D
. I $D(DDS),DGCNT=4 D
. . W !,"Press RETURN to continue..."
. . R DGRET:$S('$D(DTIME):300,1:DTIME)
. . D CLRMSG^DDS
. . W ">>> Active Patient Record Flag(s):"
. . S DGCNT=0
. S DGPFFLAG=$P($G(DGPFAPI(DGPFIEN,"FLAG")),U,2)
. Q:(DGPFFLAG'["")
. S DGPFCAT=$P($P($G(DGPFAPI(DGPFIEN,"CATEGORY")),U,2)," ")
. W !?5,IORVON,"<"_DGPFFLAG_">",IORVOFF,?45,"CATEGORY ",DGPFCAT
. S DGCNT=DGCNT+1
W:'$D(DDS) !
Q
;
ASKDET() ;does user want to display flag details?
;
; Input:
; None
;
; Output:
; Function value - return 1 on YES; otherwise 0
;
N YN,%,%Y
F D Q:"^YN"[YN
. W !,"Do you wish to view active patient record flag details"
. S %=1 ;default to YES
. D YN^DICN
. S YN=$S(%=-1:"^",%=1:"Y",%=2:"N",1:"?")
. I YN="?" D:$D(DDS) CLRMSG^DDS W !,"Enter either 'Y' or 'N'."
Q (YN="Y")
;
DISPPRF(DGDFN) ; Patient Record Flags screen Display
;
; Supported References:
; DBIA #10096 Z OPERATING SYSTEM FILE (%ZOSF)
; DBIA #10150 ScreenMan API: Form Utilities
;
; Input:
; DGDFN - pointer to patient in PATIENT (#2) file
;
; Output:
; none
;
; patient ien not setup
S DGDFN=+$G(DGDFN)
Q:'DGDFN
;
N DGPFAPI
;
; call API to get the display array for ALL Active Assignments
S DGPFAPI=$$GETACT^DGPFAPI(DGDFN,"DGPFAPI") ;DBIA #3860
;
; quit if no Active Record Flags to display
Q:'+DGPFAPI
;
; call api to display Active Record Flags
D DISPACT(.DGPFAPI)
;
; prompt and display assignment details
I $$ASKDET() D EN^DGPFLMD(DGDFN,.DGPFAPI) ;ListMan
;
; cleanup display for ScreenMan
I $D(DDS) D D CLRMSG^DDS D REFRESH^DDSUTL
. ;set right margin to zero - needed for Cache
. N X
. S X=0 X ^%ZOSF("RM")
Q
;
SELPAT(DGPAT) ;This procedure is used to perform a patient lookup for an existing patient in the PATIENT (#2) file.
;
; Input: None
;
; Output:
; DGPAT - result array containing the patient selection on success,
; pass by reference. Array will have same structure as the Y
; variable returned by the ^DIC call.
; Array Format:
; -------------
; DGPAT = IEN of patient in PATIENT (#2) file on
; success, -1 on failure
; DGPAT(0) = zero node of entry selected
; DGPAT(0,0) = external form of the .01 field of the entry
;
;- int input vars for ^DIC call
N DIC,DTOUT,DUPOT,X,Y
S DIC="^DPT(",DIC(0)="AEMQZV"
;
;- lookup patient
D ^DIC K DIC
;
;- result of lookup
S DGPAT=Y
;
;- if success, setup return array using output vars from ^DIC call
I (+DGPAT>0) D
. S DGPAT=+Y ;patient ien
. S DGPAT(0)=$G(Y(0)) ;zero node of patient in (#2) file
. S DGPAT(0,0)=$G(Y(0,0)) ;external form of the .01 field
;
Q
;
GETFLAG(DGPFPTR,DGPFLAG) ;retrieve a single FLAG record
; This function acts as a wrapper around the $$GETLF and $$GETNF
; API's. Function will be used to obtain a single flag record from
; either the PRF LOCAL FLAG (#26.11) file or the PRF NATIONAL FLAG
; (#26.15) file depending on the value of the DGPFPTR input parameter.
;
; Input:
; DGPFPTR - (required) IEN of patient record flag in PRF NATIONAL
; FLAG (#26.15) file or PRF LOCAL FLAG (#26.11) file.
; [ex: "1;DGPF(26.15,"]
;
; Output:
; Function Value - returns 1 on success, 0 on failure
; DGPFLAG - (required) result array passed by reference. See the
; $$GETLF and $$GETNF for the result array structure.
;
N RESULT ;returned function value
N DGPFIEN ;ien of PRF local or national flag file
N DGPFILE ;file # of PRF local or national flag file
;
S RESULT=0
;
D
. ;-- quit if pointer is not valid
. Q:$G(DGPFPTR)']""
. Q:'$$TESTVAL^DGPFUT(26.13,.02,DGPFPTR)
. ;
. ;-- get ien and file from pointer value
. S DGPFIEN=+$G(DGPFPTR)
. S DGPFILE=$P($G(DGPFPTR),";",2)
. ;
. ;-- if local flag file, get local flag into DGPFLAG array
. I DGPFILE["26.11" D
. . Q:'$$GETLF^DGPFALF(+DGPFIEN,.DGPFLAG)
. . S RESULT=1 ;success
. ;
. ;-- if national flag file, get national flag into DGPFLAG array
. I DGPFILE["26.15" D
. . Q:'$$GETNF^DGPFANF(+DGPFIEN,.DGPFLAG)
. . S RESULT=1 ;success
;
Q RESULT
;
PARENT(DGCHILD) ;lookup and return the parent of a child
;
; Input:
; DGCHILD - pointer to INSTITUTION (#4) file
;
; Output:
; Function value - INSTITUTION file pointer^institution name^station#
; of parent facility on success; 0 on failure
;
N DGPARENT ;function value
N DGPARR ;return array from XUAF4
;
S DGCHILD=+$G(DGCHILD)
D PARENT^XUAF4("DGPARR","`"_DGCHILD,"PARENT FACILITY")
S DGPARENT=+$O(DGPARR("P",0))
I DGPARENT S DGPARENT=DGPARENT_U_$P(DGPARR("P",DGPARENT),U)_U_$P(DGPARR("P",DGPARENT),U,2)
Q DGPARENT
;
FMTPRNT(DGCHILD) ;lookup and return parent of a child in display format
;
; Input:
; DGCHILD - pointer to INSTITUTION (#4) file
;
; Output:
; Function value - formatted name of parent institution on success;
; null on failure
;
N DGPARENT ;parent facility name
S DGCHILD=+$G(DGCHILD)
S DGPARENT=$P($$PARENT(DGCHILD),U,2)
Q $S(DGPARENT]"":"("_DGPARENT_")",1:"")
;
CNTRECS(DGFILE) ;return number of records of a file
;
; Input:
; DGFILE - (Required) file number to search
;
; Output:
; Function Value - number of records found
;
N DGCNT ;returned function value
N DGERR ;FM error message array
N DGLIST ;FM array of record ien's
;
S DGCNT=0
I $G(DGFILE)]"" D
. D LIST^DIC(DGFILE,"","@","Q","*","","","","","","DGLIST","DGERR")
. Q:$D(DGERR)
. S DGCNT=+$G(DGLIST("DILIST",0))
Q DGCNT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPFUT1 6681 printed Apr 09, 2024@21:53:36 Page 2
DGPFUT1 ;ALB/RBS - PRF UTILITIES CONTINUED ; 6/9/06 10:56am
+1 ;;5.3;Registration;**425,607,650**;Aug 13, 1993;Build 3
+2 ;
+3 ;no direct entry
QUIT
+4 ;
DISPACT(DGPFAPI) ;Display all ACTIVE Patient Record Flag's for a patient
+1 ; Input: DGPFAPI() = Array of patients active flags
+2 ; (passed by reference)
+3 ; See $$GETACT^DGPFAPI for array format.
+4 ; Output: None
+5 ;
+6 ;no flags
IF '$GET(DGPFAPI)
QUIT
+7 ;
+8 NEW DGPF,DGPFIEN,DGPFFLAG,DGPFCAT,IORVON,IORVOFF
+9 ;flag display count
NEW DGCNT
+10 ;return
NEW DGRET
+11 ;
+12 IF $DATA(DDS)
DO CLRMSG^DDS
+13 if '$DATA(DDS)
WRITE !!
WRITE ">>> Active Patient Record Flag(s):"
+14 ;
+15 ; setup for reverse video display
+16 ;
+17 SET (IORVON,IORVOFF)=""
+18 if $DATA(IOST(0))
Begin DoDot:1
+19 NEW X
SET X="IORVON;IORVOFF"
DO ENDR^%ZISS
End DoDot:1
+20 ;
+21 ; loop all returned Active Record Flag Assignment ien's
+22 SET DGCNT=0
+23 SET DGPFIEN=""
FOR
SET DGPFIEN=$ORDER(DGPFAPI(DGPFIEN))
if DGPFIEN=""
QUIT
Begin DoDot:1
+24 IF $DATA(DDS)
IF DGCNT=4
Begin DoDot:2
+25 WRITE !,"Press RETURN to continue..."
+26 READ DGRET:$SELECT('$DATA(DTIME):300,1:DTIME)
+27 DO CLRMSG^DDS
+28 WRITE ">>> Active Patient Record Flag(s):"
+29 SET DGCNT=0
End DoDot:2
+30 SET DGPFFLAG=$PIECE($GET(DGPFAPI(DGPFIEN,"FLAG")),U,2)
+31 if (DGPFFLAG'["")
QUIT
+32 SET DGPFCAT=$PIECE($PIECE($GET(DGPFAPI(DGPFIEN,"CATEGORY")),U,2)," ")
+33 WRITE !?5,IORVON,"<"_DGPFFLAG_">",IORVOFF,?45,"CATEGORY ",DGPFCAT
+34 SET DGCNT=DGCNT+1
End DoDot:1
+35 if '$DATA(DDS)
WRITE !
+36 QUIT
+37 ;
ASKDET() ;does user want to display flag details?
+1 ;
+2 ; Input:
+3 ; None
+4 ;
+5 ; Output:
+6 ; Function value - return 1 on YES; otherwise 0
+7 ;
+8 NEW YN,%,%Y
+9 FOR
Begin DoDot:1
+10 WRITE !,"Do you wish to view active patient record flag details"
+11 ;default to YES
SET %=1
+12 DO YN^DICN
+13 SET YN=$SELECT(%=-1:"^",%=1:"Y",%=2:"N",1:"?")
+14 IF YN="?"
if $DATA(DDS)
DO CLRMSG^DDS
WRITE !,"Enter either 'Y' or 'N'."
End DoDot:1
if "^YN"[YN
QUIT
+15 QUIT (YN="Y")
+16 ;
DISPPRF(DGDFN) ; Patient Record Flags screen Display
+1 ;
+2 ; Supported References:
+3 ; DBIA #10096 Z OPERATING SYSTEM FILE (%ZOSF)
+4 ; DBIA #10150 ScreenMan API: Form Utilities
+5 ;
+6 ; Input:
+7 ; DGDFN - pointer to patient in PATIENT (#2) file
+8 ;
+9 ; Output:
+10 ; none
+11 ;
+12 ; patient ien not setup
+13 SET DGDFN=+$GET(DGDFN)
+14 if 'DGDFN
QUIT
+15 ;
+16 NEW DGPFAPI
+17 ;
+18 ; call API to get the display array for ALL Active Assignments
+19 ;DBIA #3860
SET DGPFAPI=$$GETACT^DGPFAPI(DGDFN,"DGPFAPI")
+20 ;
+21 ; quit if no Active Record Flags to display
+22 if '+DGPFAPI
QUIT
+23 ;
+24 ; call api to display Active Record Flags
+25 DO DISPACT(.DGPFAPI)
+26 ;
+27 ; prompt and display assignment details
+28 ;ListMan
IF $$ASKDET()
DO EN^DGPFLMD(DGDFN,.DGPFAPI)
+29 ;
+30 ; cleanup display for ScreenMan
+31 IF $DATA(DDS)
Begin DoDot:1
+32 ;set right margin to zero - needed for Cache
+33 NEW X
+34 SET X=0
XECUTE ^%ZOSF("RM")
End DoDot:1
DO CLRMSG^DDS
DO REFRESH^DDSUTL
+35 QUIT
+36 ;
SELPAT(DGPAT) ;This procedure is used to perform a patient lookup for an existing patient in the PATIENT (#2) file.
+1 ;
+2 ; Input: None
+3 ;
+4 ; Output:
+5 ; DGPAT - result array containing the patient selection on success,
+6 ; pass by reference. Array will have same structure as the Y
+7 ; variable returned by the ^DIC call.
+8 ; Array Format:
+9 ; -------------
+10 ; DGPAT = IEN of patient in PATIENT (#2) file on
+11 ; success, -1 on failure
+12 ; DGPAT(0) = zero node of entry selected
+13 ; DGPAT(0,0) = external form of the .01 field of the entry
+14 ;
+15 ;- int input vars for ^DIC call
+16 NEW DIC,DTOUT,DUPOT,X,Y
+17 SET DIC="^DPT("
SET DIC(0)="AEMQZV"
+18 ;
+19 ;- lookup patient
+20 DO ^DIC
KILL DIC
+21 ;
+22 ;- result of lookup
+23 SET DGPAT=Y
+24 ;
+25 ;- if success, setup return array using output vars from ^DIC call
+26 IF (+DGPAT>0)
Begin DoDot:1
+27 ;patient ien
SET DGPAT=+Y
+28 ;zero node of patient in (#2) file
SET DGPAT(0)=$GET(Y(0))
+29 ;external form of the .01 field
SET DGPAT(0,0)=$GET(Y(0,0))
End DoDot:1
+30 ;
+31 QUIT
+32 ;
GETFLAG(DGPFPTR,DGPFLAG) ;retrieve a single FLAG record
+1 ; This function acts as a wrapper around the $$GETLF and $$GETNF
+2 ; API's. Function will be used to obtain a single flag record from
+3 ; either the PRF LOCAL FLAG (#26.11) file or the PRF NATIONAL FLAG
+4 ; (#26.15) file depending on the value of the DGPFPTR input parameter.
+5 ;
+6 ; Input:
+7 ; DGPFPTR - (required) IEN of patient record flag in PRF NATIONAL
+8 ; FLAG (#26.15) file or PRF LOCAL FLAG (#26.11) file.
+9 ; [ex: "1;DGPF(26.15,"]
+10 ;
+11 ; Output:
+12 ; Function Value - returns 1 on success, 0 on failure
+13 ; DGPFLAG - (required) result array passed by reference. See the
+14 ; $$GETLF and $$GETNF for the result array structure.
+15 ;
+16 ;returned function value
NEW RESULT
+17 ;ien of PRF local or national flag file
NEW DGPFIEN
+18 ;file # of PRF local or national flag file
NEW DGPFILE
+19 ;
+20 SET RESULT=0
+21 ;
+22 Begin DoDot:1
+23 ;-- quit if pointer is not valid
+24 if $GET(DGPFPTR)']""
QUIT
+25 if '$$TESTVAL^DGPFUT(26.13,.02,DGPFPTR)
QUIT
+26 ;
+27 ;-- get ien and file from pointer value
+28 SET DGPFIEN=+$GET(DGPFPTR)
+29 SET DGPFILE=$PIECE($GET(DGPFPTR),";",2)
+30 ;
+31 ;-- if local flag file, get local flag into DGPFLAG array
+32 IF DGPFILE["26.11"
Begin DoDot:2
+33 if '$$GETLF^DGPFALF(+DGPFIEN,.DGPFLAG)
QUIT
+34 ;success
SET RESULT=1
End DoDot:2
+35 ;
+36 ;-- if national flag file, get national flag into DGPFLAG array
+37 IF DGPFILE["26.15"
Begin DoDot:2
+38 if '$$GETNF^DGPFANF(+DGPFIEN,.DGPFLAG)
QUIT
+39 ;success
SET RESULT=1
End DoDot:2
End DoDot:1
+40 ;
+41 QUIT RESULT
+42 ;
PARENT(DGCHILD) ;lookup and return the parent of a child
+1 ;
+2 ; Input:
+3 ; DGCHILD - pointer to INSTITUTION (#4) file
+4 ;
+5 ; Output:
+6 ; Function value - INSTITUTION file pointer^institution name^station#
+7 ; of parent facility on success; 0 on failure
+8 ;
+9 ;function value
NEW DGPARENT
+10 ;return array from XUAF4
NEW DGPARR
+11 ;
+12 SET DGCHILD=+$GET(DGCHILD)
+13 DO PARENT^XUAF4("DGPARR","`"_DGCHILD,"PARENT FACILITY")
+14 SET DGPARENT=+$ORDER(DGPARR("P",0))
+15 IF DGPARENT
SET DGPARENT=DGPARENT_U_$PIECE(DGPARR("P",DGPARENT),U)_U_$PIECE(DGPARR("P",DGPARENT),U,2)
+16 QUIT DGPARENT
+17 ;
FMTPRNT(DGCHILD) ;lookup and return parent of a child in display format
+1 ;
+2 ; Input:
+3 ; DGCHILD - pointer to INSTITUTION (#4) file
+4 ;
+5 ; Output:
+6 ; Function value - formatted name of parent institution on success;
+7 ; null on failure
+8 ;
+9 ;parent facility name
NEW DGPARENT
+10 SET DGCHILD=+$GET(DGCHILD)
+11 SET DGPARENT=$PIECE($$PARENT(DGCHILD),U,2)
+12 QUIT $SELECT(DGPARENT]"":"("_DGPARENT_")",1:"")
+13 ;
CNTRECS(DGFILE) ;return number of records of a file
+1 ;
+2 ; Input:
+3 ; DGFILE - (Required) file number to search
+4 ;
+5 ; Output:
+6 ; Function Value - number of records found
+7 ;
+8 ;returned function value
NEW DGCNT
+9 ;FM error message array
NEW DGERR
+10 ;FM array of record ien's
NEW DGLIST
+11 ;
+12 SET DGCNT=0
+13 IF $GET(DGFILE)]""
Begin DoDot:1
+14 DO LIST^DIC(DGFILE,"","@","Q","*","","","","","","DGLIST","DGERR")
+15 if $DATA(DGERR)
QUIT
+16 SET DGCNT=+$GET(DGLIST("DILIST",0))
End DoDot:1
+17 QUIT DGCNT
