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

DGPFUT4.m

Go to the documentation of this file.
  1. DGPFUT4 ;ALB/SAE - PRF UTILITIES CONTINUED ; 6/9/04 1:33pm
  1. ;;5.3;Registration;**554,951**;Aug 13, 1993;Build 135
  1. ; Last Edited: SHRPE/sgm - Jul 31, 2018 15:36
  1. ;
  1. Q ; no direct entry
  1. ;
  1. BLDGLOB(DGPFDA,DGPFHX,TXN,DGPFLOUT,DGPFGOUT) ; build global
  1. ;
  1. ; This procedure builds the temporary global for display.
  1. ; It first determines the longest label, then it steps thru the $TEXT
  1. ; list of labels of fields, which control the order of nodes created.
  1. ; For each label it appends the field value then adds the resulting
  1. ; value to the temporary global ^TMP("DGPFARY",$J).
  1. ;
  1. ; Input:
  1. ; DGPFDA - data array
  1. ; - derived from DGPFA if called by Flag Assignment transaction
  1. ; - derived from DGPFLF if called by Flag Management transaction
  1. ; DGPFHX - history array
  1. ; - derived from DGPFAH if called by Flag Assignment transaction
  1. ; - derived from DGPFLH if called by Flag Management transaction
  1. ; TXN - transaction - one of the following:
  1. ; FA - FLAG ASSIGNMENT - Assign Flag
  1. ; FA - FLAG ASSIGNMENT - Edit Flag Assignment
  1. ; FA - FLAG ASSIGNMENT - Change Assignment Ownership
  1. ; FM - FLAG MANAGEMENT - Add New Record Flag
  1. ; FM - FLAG MANAGEMENT - Edit Record Flag
  1. ; DGPFLOUT - (L)ocal (OUT)put array, containing non-WP fields
  1. ; DGPFGOUT - (G)lobal (OUT)put array name to be built.
  1. ;
  1. ; Output:
  1. ; DGPFGOUT - (G)lobal (OUT)put - name of ^TMP global built
  1. ; Contains assignment detail
  1. ; This global is displayed to screen for user.
  1. ;
  1. ; Temporary variables:
  1. N DGPFROOT ; Array root subscript
  1. N DGPFCOL ; Column value for each display field, stored in text block
  1. N DGPFLABL ; Label of DGPFROOT for display
  1. N DGPFVAL ; Value from DGPFROOT array node
  1. N DGPFPAD ; Holds padded spaces for display alignment
  1. N DGPFOFST ; Offset of text line in text subroutine
  1. N DGPFLONG ; Longest label for later display
  1. N DGPFLINE ; Line number incremented during final global build in SET
  1. N DGPFRTN ; Routine that contains the TEXT from which to read
  1. N DGPFTEXT ; value of text line retrieved from TEXT
  1. N DGPFTAG ; tag at offset of TEXT
  1. N DGPFSR ; TEXT subroutine to use to acquire data
  1. N DGPFPICT ; count of number of times PRININV array has been read
  1. ;
  1. S DGPFLINE=0
  1. S DGPFRTN=$P(TXN,U)_"TXT"
  1. S DGPFPICT=0
  1. ;
  1. ; determine longest label - set this value into the variable DGPFLONG:
  1. S DGPFLONG=1
  1. F DGPFOFST=2:1 D Q:DGPFROOT=""!(DGPFROOT="QUIT")
  1. . S DGPFTAG=DGPFRTN_"+"_DGPFOFST,DGPFTEXT=$T(@DGPFTAG)
  1. . S DGPFROOT=$P(DGPFTEXT,";",3)
  1. . Q:DGPFROOT=""!(";DESC;NARR;COMMENT;REASON;QUIT;"[(";"_DGPFROOT_";"))
  1. . I DGPFROOT="PRININV",'$D(DGPFLOUT(DGPFROOT)) Q
  1. . S DGPFLABL=$P(DGPFTEXT,";",5)
  1. . S DGPFLONG=$S($L(DGPFLABL)+1>DGPFLONG:$L(DGPFLABL)+1,1:DGPFLONG)
  1. ;
  1. ; step thru the text - this controls the order of display
  1. F DGPFOFST=2:1 D Q:DGPFROOT=""!(DGPFROOT="QUIT")
  1. . S DGPFTAG=DGPFRTN_"+"_DGPFOFST,DGPFTEXT=$T(@DGPFTAG)
  1. . S DGPFROOT=$P(DGPFTEXT,";",3)
  1. . S DGPFLABL=$P(DGPFTEXT,";",5)
  1. . Q:DGPFROOT=""!(DGPFROOT="QUIT")
  1. . ;
  1. . ; build array from Principal Investigator multiple
  1. . I DGPFROOT="PRININV" D Q
  1. . . D BLDPI(DGPFROOT,DGPFLABL,DGPFLONG,.DGPFLINE,.DGPFLOUT,DGPFGOUT)
  1. . ;
  1. . ; build array from word-processing multiple:
  1. . I ";DESC;NARR;COMMENT;REASON;"[(";"_DGPFROOT_";") D Q
  1. . . D BLDWP(DGPFROOT,DGPFLABL,.DGPFLINE,.DGPFLOUT,DGPFGOUT)
  1. . ;
  1. . ; DG*5.3*951 introduces a multiple
  1. . S DGPFCOL=DGPFLONG-$L(DGPFLABL)
  1. . S DGPFPAD=$E($J("",DGPFCOL),1,DGPFCOL)
  1. . I DGPFROOT'["DBRS" D
  1. . . S DGPFVAL=DGPFPAD_DGPFLABL_DGPFLOUT(DGPFROOT)
  1. . . S DGPFLINE=DGPFLINE+1
  1. . . S @DGPFGOUT@(DGPFLINE,0)=DGPFVAL
  1. . . Q
  1. . I DGPFROOT="DBRS#" I DGPFLOUT("FLAGNAME")="BEHAVIORAL" D DBRS
  1. . Q
  1. Q
  1. ;
  1. BLDPI(DGPFROOT,DGPFLABL,DGPFLONG,DGPFLINE,DGPFLOUT,DGPFGOUT) ;
  1. ;
  1. ; Add each of the nodes from the PRININV array multiple to temp global.
  1. ;
  1. ; Input:
  1. ; DGPFROOT - Name of the field derived from the $TEXT segment below
  1. ; DGPFLABL - Label
  1. ; DGPFLONG - Contains length of longest label
  1. ; DGPFLINE - Line number for incrementing of global array nodes
  1. ; DGPFLOUT - Local array of WP text
  1. ; DGPFGOUT - (G)lobal (OUT)put - name of ^TMP global built
  1. ;
  1. ; Output:
  1. ; none - build DGPFGOUT - (G)lobal (OUT)put ^TMP global
  1. ;
  1. ; Temporary variables:
  1. N DGPFSUB ; subscript
  1. N DGPFPAD ; padding for leading spaces for display
  1. N DGPFCOL ; column value for Principal Investigator label
  1. N DGPFVAL ; value from DGPFROOT array node
  1. ;
  1. S DGPFCOL=DGPFLONG-$L(DGPFLABL)
  1. S DGPFPAD=$E($J("",DGPFCOL),1,DGPFCOL)
  1. ;
  1. S DGPFSUB=""
  1. F S DGPFSUB=$O(DGPFLOUT(DGPFROOT,DGPFSUB)) Q:'DGPFSUB D
  1. . S DGPFVAL=DGPFPAD_DGPFLABL_$G(DGPFLOUT(DGPFROOT,DGPFSUB,0))
  1. . ;
  1. . S DGPFLINE=DGPFLINE+1
  1. . S @DGPFGOUT@(DGPFLINE,0)=DGPFVAL
  1. Q
  1. ;
  1. BLDWP(DGPFROOT,DGPFLABL,DGPFLINE,DGPFLOUT,DGPFGOUT) ;build WP array
  1. ;
  1. ; This procedure adds each of the nodes from the word-processing
  1. ; multiple to the temp global (^TMP).
  1. ;
  1. ; Input:
  1. ; DGPFROOT - Name of the field derived from the $TEXT segment below
  1. ; DGPFLABL - label
  1. ; DGPFLINE - Line number for incrementing of global array nodes
  1. ; DGPFLOUT - Local array of WP text to be added to the global array
  1. ; DGPFGOUT - (G)lobal (OUT)put - name of ^TMP global built
  1. ;
  1. ; Output:
  1. ; none - build DGPFGOUT - (G)lobal (OUT)put ^TMP global
  1. ;
  1. ; Temporary variables:
  1. N DGSUB ; subscript value in word processing fields
  1. N DGPFPAD ; Padding as spaces for alignment of headers
  1. N DGPFVAL ; value from DGPFROOT array node
  1. ;
  1. S DGPFPAD=" "
  1. ;
  1. ; insert header for narrative:
  1. S DGPFVAL=DGPFPAD_DGPFLABL
  1. ;
  1. S DGPFLINE=DGPFLINE+1
  1. S @DGPFGOUT@(DGPFLINE,0)=DGPFVAL
  1. ;
  1. ; set each word processing line
  1. S DGSUB=0
  1. F S DGSUB=$O(DGPFLOUT(DGPFROOT,DGSUB)) Q:'DGSUB D
  1. . S DGPFVAL=DGPFPAD_$G(DGPFLOUT(DGPFROOT,DGSUB,0))
  1. . ;
  1. . S DGPFLINE=DGPFLINE+1
  1. . S @DGPFGOUT@(DGPFLINE,0)=DGPFVAL
  1. Q
  1. ;
  1. DBRS ; DG*5.3*951 - display data in DBRS multiple
  1. ; got here where DBRS# text line processed
  1. N I,J,X,LBL,PAD,ROOT,VAL
  1. S PAD(1)=DGPFPAD
  1. S LBL(1)=DGPFLABL
  1. S ROOT(1)=DGPFROOT
  1. ; get settings for second field
  1. S DGPFOFST=DGPFOFST+1
  1. S DGPFTAG=DGPFRTN_"+"_DGPFOFST,DGPFTEXT=$T(@DGPFTAG)
  1. S DGPFROOT=$P(DGPFTEXT,";",3) S ROOT(2)=DGPFROOT
  1. S DGPFLABL=$P(DGPFTEXT,";",5) S LBL(2)=DGPFLABL
  1. S DGPFCOL=DGPFLONG-$L(DGPFLABL)
  1. S DGPFPAD=$E($J("",DGPFCOL),1,DGPFCOL) S PAD(2)=DGPFPAD
  1. S I=0 F J=0:0 S I=$O(DGPFLOUT("DBRS#",I)) Q:'I D
  1. . S VAL=PAD(1)_LBL(1)_DGPFLOUT(ROOT(1),I)
  1. . S DGPFLINE=DGPFLINE+1
  1. . S @DGPFGOUT@(DGPFLINE,0)=VAL
  1. . S VAL=$G(DGPFLOUT(ROOT(2),I))
  1. . S:VAL="" VAL="<no value>"
  1. . S VAL=PAD(2)_LBL(2)_VAL
  1. . S DGPFLINE=DGPFLINE+1
  1. . S @DGPFGOUT@(DGPFLINE,0)=VAL
  1. . Q
  1. Q
  1. ;
  1. FATXT ; ordered list of fields to be presented to user for Flag Assignment
  1. ;;ROOT; ;LABEL;
  1. ;;PATIENT; ;Patient Name: ;
  1. ;;FLAGNAME; ;Flag Name: ;
  1. ;;FLAGTYPE; ;Flag Type: ;
  1. ;;CATEGORY; ;Flag Category: ;
  1. ;;STATUS; ;Assignment Status: ;
  1. ;;INITASSIGN; ;Initial Assignment: ;
  1. ;;LASTREVIEW; ;Last Review Date: ;
  1. ;;REVIEWDT; ;Next Review Date: ;
  1. ;;OWNER; ;Owner Site: ;
  1. ;;ORIGSITE; ;Originating Site: ;
  1. ;;ACTION; ;Assignment Action: ;
  1. ;;ACTIONDT; ;Action Date: ;
  1. ;;ENTERBY; ;Entered By: ;
  1. ;;APPRVBY; ;Approved By: ;
  1. ;;DBRS#; ;DBRS No.: ;
  1. ;;DBRS OTHER; ;DBRS Other: ;
  1. ;;NARR; ;Record Flag Assignment Narrative: ;
  1. ;;COMMENT; ;Action Comments: ;
  1. ;;QUIT;
  1. Q
  1. ;
  1. FMTXT ; ordered list of fields to be presented to user for Flag Management
  1. ;;ROOT; ;LABEL;
  1. ;;FLAGNAME; ;Flag Name: ;
  1. ;;CATEGORY; ;Flag Category: ;
  1. ;;FLAGTYPE; ;Flag Type: ;
  1. ;;STATUS; ;Flag Status: ;
  1. ;;REVFREQ; ;Review Frequency Days: ;
  1. ;;NOTIDAYS; ;Notification Days: ;
  1. ;;REVGRP; ;Review Mail Group: ;
  1. ;;TIUTITLE; ;Progress Note Title: ;
  1. ;;ENTERDT; ;Enter/Edit On: ;
  1. ;;ENTERBY; ;Enter/Edit By: ;
  1. ;;PRININV; ;Principal Investigator(s): ;
  1. ;;DESC; ;Flag Description: ;
  1. ;;REASON; ;Reason For Flag Enter/Edit: ;
  1. ;;QUIT;
  1. Q