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

DGPFUT1.m

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