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

DGPFUT2.m

Go to the documentation of this file.
  1. DGPFUT2 ;ALB/KCL - PRF UTILITIES CONTINUED ; 2/12/2020
  1. ;;5.3;Registration;**425,554,650,1005,1028,1054,1069**;Aug 13, 1993;Build 3
  1. ;
  1. ; This routine contains generic calls for use throughout DGPF*.
  1. ;
  1. ;- no direct entry
  1. QUIT
  1. ;
  1. ;
  1. GETPAT(DGDFN,DGPAT) ;retrieve patient identifying information
  1. ; Used to obtain identifying information for a patient
  1. ; in the PATIENT (#2) file and place it in an array format.
  1. ;
  1. ; NOTE: Direct global reference of patient's zero node in the
  1. ; PATIENT (#2) file is supported by DBIA #10035
  1. ;
  1. ; Input:
  1. ; DGDFN - (required) ien of patient in PATIENT (#2) file
  1. ;
  1. ; Output:
  1. ; Function Value - returns 1 on success, 0 on failure
  1. ; DGPAT - output array containing the patient identifying information,
  1. ; on success, pass by reference.
  1. ; Array subscripts are:
  1. ; "DFN" - ien PATIENT (#2) file
  1. ; "NAME" - patient name
  1. ; "SSN" - patient Social Security Number
  1. ; "DOB" - patient date of birth (FM format)
  1. ; "SEX" - patient sex
  1. ;
  1. N DGNODE
  1. N RESULT
  1. ;
  1. S RESULT=0
  1. ;
  1. I $G(DGDFN)>0,$D(^DPT(DGDFN,0)) D
  1. .
  1. . ;-- obtain zero node of patient record (supported by DBIA #10035)
  1. . S DGNODE=$G(^DPT(DGDFN,0))
  1. . ;
  1. . S DGPAT("DFN")=DGDFN
  1. . S DGPAT("NAME")=$P(DGNODE,"^")
  1. . S DGPAT("SEX")=$P(DGNODE,"^",2)
  1. . S DGPAT("DOB")=$P(DGNODE,"^",3)
  1. . S DGPAT("SSN")=$P(DGNODE,"^",9)
  1. . S RESULT=1 ;success
  1. ;
  1. Q RESULT
  1. ;
  1. GETDFN(DGICN,DGEROOT) ;Used to convert an ICN to a DFN.
  1. ;
  1. ; Supported DBIA #2701: The supported DBIA is used to retrieve the
  1. ; pointer (DFN) to the PATIENT (#2) file for a
  1. ; given ICN.
  1. ;
  1. ; Input:
  1. ; DGICN - Integrated Control Number with or without checksum
  1. ; DGEROOT - (optional) closed root array name (i.e. "DGERROR") for
  1. ; error dialog returned from BLD^DIALOG. If not passed,
  1. ; error dialog is returned in ^TMP("DIERR",$J) global.
  1. ;
  1. ; Output:
  1. ; Function Value - DFN on success, 0 on failure
  1. ; DGEROOT() - error output array from BLD^DIALOG
  1. ;
  1. N DGDFN ;ptr to patient
  1. N DIERR ;var returned from BLD^DIALOG
  1. ;
  1. ;init error output array if passed
  1. S DGEROOT=$G(DGEROOT)
  1. I DGEROOT]"" K @DGEROOT
  1. ;
  1. S DGDFN=+$$GETDFN^MPIF001(+$G(DGICN))
  1. I DGDFN'>0 D BLD^DIALOG(261127,,,DGEROOT,"F")
  1. ;
  1. Q $S(DGDFN'>0:0,1:DGDFN)
  1. ;
  1. SORT(DGPFARR) ;Re-sort of active record assignments by category then flag name
  1. ; This function re-sorts the active record flag assignment list for a
  1. ; patient by category (Cat I or Cat II) and then by flag name.
  1. ;
  1. ; Input: [Required]
  1. ; DGPFARR - Closed root reference array name of active assignments
  1. ; to be sorted
  1. ;
  1. ; Output:
  1. ; Function Value - returns 1 on success, 0 on failure
  1. ;
  1. ; DGPFARR() - Closed Root reference name of re-sorted assignments
  1. ; - Category I's will sort first in the returned array.
  1. ; - Category II's will sort second.
  1. ;
  1. N DGCAT ;category
  1. N DGINDX ;index array
  1. N DGNAME ;flag name
  1. N DGSORT ;re-sorted data array
  1. N DGX ;generic counter
  1. ;
  1. ; check for input value - Quit if none found
  1. Q:DGPFARR']"" 0
  1. Q:'$O(@DGPFARR@("")) 0
  1. ;
  1. S DGSORT=$NA(^TMP("DGPFUT2",$J))
  1. K @DGSORT
  1. ;
  1. ;build index - ARRAY(Category (I or II),Flag Name)=sort number
  1. S DGX=0
  1. F S DGX=$O(@DGPFARR@(DGX)) Q:'DGX D
  1. . S DGCAT=$S($P(@DGPFARR@(DGX,"FLAG"),U)[26.11:2,1:1)
  1. . S DGINDX(DGCAT,$P(@DGPFARR@(DGX,"FLAG"),U,2))=DGX
  1. ;
  1. ;build sorted data array -
  1. S (DGCAT,DGX)=0
  1. F S DGCAT=$O(DGINDX(DGCAT)) Q:'DGCAT D
  1. . S DGNAME=""
  1. . F S DGNAME=$O(DGINDX(DGCAT,DGNAME)) Q:DGNAME="" D
  1. . . S DGX=DGX+1
  1. . . M @DGSORT@(DGX)=@DGPFARR@(DGINDX(DGCAT,DGNAME))
  1. ;
  1. ;remove input array and replace with sorted array, kill sort array
  1. K @DGPFARR
  1. M @DGPFARR=@DGSORT
  1. K @DGSORT
  1. ;
  1. Q 1
  1. ;
  1. ACTDT ; update PRF Software Activation Date field in (#26.18)
  1. ; This utility should only be run at the Alpha and Beta test sites
  1. ; of the Patient Record Flags Project, Patch DG*5.3*425.
  1. ; If necessary, this entry point will change the date that the
  1. ; Patient Record Flags (PRF) System became active.
  1. ; The (#1) PRF SOFTWARE ACTIVATION DATE field of the (#26.18) PRF
  1. ; PARAMETERS file, will be changed to: SEP 25, 2003
  1. ;
  1. ; Input: none
  1. ;
  1. ; Output: User message on successful or failure of file update
  1. ;
  1. N DGACTDT ; Nationally Released Software Activation Date value
  1. N DGIENS ; IEN - internal entry # OF (#26.18) FILE
  1. N DGFLD ; PRF Software Activation Date field #
  1. N DGFDA ; FDA data array for filer
  1. N DGERR ; error message array returned from filer
  1. N DGERRMSG ; error message for display
  1. N DGPARM ; current internal/external values of field
  1. ;
  1. S DGACTDT="SEP 25, 2003"
  1. S DGIENS="1,"
  1. S DGFLD=1
  1. ;
  1. ; display user message
  1. W !!,"Updating the PRF SOFTWARE ACTIVATION DATE (#1) field in the PRF PARAMETERS FILE (#26.18) to the value of SEP 25, 2003..."
  1. ;
  1. ; checks for necessary programmer variables
  1. I '$G(DUZ)!($G(DUZ(0))'="@")!('$G(DT))!($G(U)'="^") D
  1. . S DGERRMSG="Your programming variables are not set up properly."
  1. ;
  1. ; check if activation is not less than the current date
  1. I '$D(DGERRMSG),DT<3030925 D
  1. . S DGERRMSG="This file/field update can't be run before the date of SEP 25, 2003 is reached."
  1. ;
  1. ; get current activation date from PRF PARAMETERS (#26.18) file
  1. I '$D(DGERRMSG) D
  1. . D GETS^DIQ(26.18,"1,",1,"IE","DGPARM","DGERR")
  1. . ;
  1. . ; check for errors and inform the user
  1. . I $D(DGERR) D Q
  1. . . S DGERRMSG=$G(DGERR("DIERR",1,"TEXT",1))
  1. . ;
  1. . ; check to make sure field is not set already
  1. . I $G(DGPARM(26.18,"1,",1,"I"))=3030925 D
  1. . . S DGERRMSG="The date value is already set to SEP 25, 2003."
  1. ;
  1. ; now start the (#26.18) filing process
  1. I '$D(DGERRMSG) D
  1. . ;
  1. . ; DELETE activation date before filing since field is uneditable
  1. . S DGFDA(26.18,DGIENS,1)="@"
  1. . D FILE^DIE("","DGFDA","DGERR")
  1. . ;
  1. . ; check for errors and inform the user
  1. . I $D(DGERR) D Q
  1. . . S DGERRMSG=$G(DGERR("DIERR",1,"TEXT",1))
  1. . ;
  1. . ; setup and file the new activation date value (external)
  1. . S DGFDA(26.18,DGIENS,1)=DGACTDT
  1. . D FILE^DIE("SE","DGFDA","DGERR")
  1. . ;
  1. . ; check for success or errors and inform the user of update status
  1. . I $D(DGERR) D Q
  1. . . S DGERRMSG=$G(DGERR("DIERR",1,"TEXT",1))
  1. ;
  1. ; display successful/failure file update - updated field and value
  1. W !!,$C(7)
  1. I $D(DGERRMSG) D
  1. . W "Field could not be updated...",DGERRMSG
  1. E D
  1. . W "Field was successfully changed from ",$G(DGPARM(26.18,"1,",1,"E"))," to ",$G(DGFDA(26.18,DGIENS,DGFLD)),"."
  1. ;
  1. Q
  1. ;
  1. ;
  1. BLDTFL(DGDFN,DGTFL) ;build array of Treating Facilities
  1. ; This function builds an array of INSTITUTION (#4) file pointers
  1. ; that are non-local medical treating facilities for a given patient.
  1. ;
  1. ; Input:
  1. ; DGDFN - pointer to patient in PATIENT (#2) file
  1. ;
  1. ; Output:
  1. ; Function value - 1 on results returned; 0 on failure
  1. ; DGTFL - array of treating facility INSTITUTION (#4) file pointerS
  1. ; Format: DGTFL(pointer)=date last treated
  1. N DGSTAT,DGSTATI,DGKEY,DGOUT,DGI,DGSTI,DGIEN,DGDLT
  1. S DGSTAT=$P($$SITE^VASITE,U,3)
  1. S DGSTATI=$P($$SITE^VASITE,U)
  1. S DGKEY=DGDFN_U_"PI"_U_"USVHA"_U_DGSTAT
  1. D TFL^VAFCTFU2(.DGOUT,DGKEY)
  1. S DGI="" F S DGI=$O(DGOUT(DGI)) Q:DGI="" D
  1. . I $P(DGOUT(DGI),U,2)="PI",$P(DGOUT(DGI),U,3)="USVHA" D
  1. . . I $P(DGOUT(DGI),U,4)="200CRNR" D
  1. . . . S DGSTI=$$IEN^XUAF4($P(DGOUT(DGI),U,4))
  1. . . . S DGIEN=$O(^DGCN(391.91,"AINST",DGSTI,DGDFN,""))
  1. . . . Q:DGIEN=""
  1. . . . S DGDLT=+$P($G(^DGCN(391.91,DGIEN,0)),U,3)
  1. . . . S DGTFL(DGSTI)=DGDLT
  1. . . . Q
  1. . . S DGSTI=$$IEN^XUAF4($P(DGOUT(DGI),U,4))
  1. . . ;Q:DGSTI=""
  1. . . Q:$$GET1^DIQ(4,DGSTI_",",13)="OTHER"!(+$$STA^XUAF4(DGSTI)=200)!(DGSTI=DGSTATI)
  1. . . S DGIEN=$O(^DGCN(391.91,"AINST",DGSTI,DGDFN,""))
  1. . . Q:DGIEN=""
  1. . . S DGDLT=+$P($G(^DGCN(391.91,DGIEN,0)),U,3)
  1. . . S DGTFL(DGSTI)=DGDLT ;DG*5.3*1054 only setting entries that are VistAs and PI/USHVA records
  1. . .; S:DGSTI'=DGSTATI DGTFL(DGSTI)=DGDLT
  1. Q $S(+$O(DGTFL(0)):1,1:0)
  1. ;
  1. ;This subroutine converts the treating facility list returned by $$BLDTFL to
  1. ;the format expected by XMIT^DGPFHLU6.
  1. ;
  1. ;Input:
  1. ; DGDFN - pointer to the patient in the PATIENT (#2) file
  1. ;Output:
  1. ; DGTFL - array in the format DGTFL(#)=station number (not pointer)
  1. BLDTFL2(DGDFN,DGTFL) ;
  1. N DGI,DGJ,DGTMP,DGRET
  1. S DGRET=$$BLDTFL(DGDFN,.DGTMP)
  1. S DGJ=0
  1. S DGI="" F S DGI=$O(DGTMP(DGI)) Q:DGI="" D
  1. . S DGJ=DGJ+1
  1. . S DGTFL(DGJ)=$$STA^XUAF4(DGI)
  1. Q