- 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 Jan 18, 2025@03:49:30 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