DGPFUT4 ;ALB/SAE - PRF UTILITIES CONTINUED ; 6/9/04 1:33pm
;;5.3;Registration;**554,1015**;Aug 13, 1993;Build 21
;
Q ; no direct entry
;
BLDGLOB(DGPFDA,DGPFHX,TXN,DGPFLOUT,DGPFGOUT) ; build global
;
; This procedure builds the temporary global for display.
; It first determines the longest label, then it steps thru the $TEXT
; list of labels of fields, which control the order of nodes created.
; For each label it appends the field value then adds the resulting
; value to the temporary global ^TMP("DGPFARY",$J).
;
; Input:
; DGPFDA - data array
; - derived from DGPFA if called by Flag Assignment transaction
; - derived from DGPFLF if called by Flag Management transaction
; DGPFHX - history array
; - derived from DGPFAH if called by Flag Assignment transaction
; - derived from DGPFLH if called by Flag Management transaction
; TXN - transaction - one of the following:
; FA - FLAG ASSIGNMENT - Assign Flag
; FA - FLAG ASSIGNMENT - Edit Flag Assignment
; FA - FLAG ASSIGNMENT - Change Assignment Ownership
; FM - FLAG MANAGEMENT - Add New Record Flag
; FM - FLAG MANAGEMENT - Edit Record Flag
; DGPFLOUT - (L)ocal (OUT)put array, containing non-WP fields
; DGPFGOUT - (G)lobal (OUT)put array name to be built.
;
; Output:
; DGPFGOUT - (G)lobal (OUT)put - name of ^TMP global built
; Contains assignment detail
; This global is displayed to screen for user.
;
; Temporary variables:
N DGPFROOT ; Array root subscript
N DGPFCOL ; Column value for each display field, stored in text block
N DGPFLABL ; Label of DGPFROOT for display
N DGPFVAL ; Value from DGPFROOT array node
N DGPFPAD ; Holds padded spaces for display alignment
N DGPFOFST ; Offset of text line in text subroutine
N DGPFLONG ; Longest label for later display
N DGPFLINE ; Line number incremented during final global build in SET
N DGPFRTN ; Routine that contains the TEXT from which to read
N DGPFTEXT ; value of text line retrieved from TEXT
N DGPFTAG ; tag at offset of TEXT
N DGPFSR ; TEXT subroutine to use to acquire data
N DGPFPICT ; count of number of times PRININV array has been read
;
S DGPFLINE=0
S DGPFRTN=$P(TXN,U)_"TXT"
S DGPFPICT=0
;
; determine longest label - set this value into the variable DGPFLONG:
S DGPFLONG=1
F DGPFOFST=2:1 D Q:DGPFROOT=""!(DGPFROOT="QUIT")
. S DGPFTAG=DGPFRTN_"+"_DGPFOFST,DGPFTEXT=$T(@DGPFTAG)
. S DGPFROOT=$P(DGPFTEXT,";",3)
. Q:DGPFROOT=""!(";DESC;NARR;COMMENT;REASON;QUIT;"[(";"_DGPFROOT_";"))
. I DGPFROOT="PRININV",'$D(DGPFLOUT(DGPFROOT)) Q
. S DGPFLABL=$P(DGPFTEXT,";",5)
. S DGPFLONG=$S($L(DGPFLABL)+1>DGPFLONG:$L(DGPFLABL)+1,1:DGPFLONG)
;
; step thru the text - this controls the order of display
F DGPFOFST=2:1 D Q:DGPFROOT=""!(DGPFROOT="QUIT")
. S DGPFTAG=DGPFRTN_"+"_DGPFOFST,DGPFTEXT=$T(@DGPFTAG)
. S DGPFROOT=$P(DGPFTEXT,";",3)
. S DGPFLABL=$P(DGPFTEXT,";",5)
. Q:DGPFROOT=""!(DGPFROOT="QUIT")
. ;
. ; build array from Principal Investigator multiple
. I DGPFROOT="PRININV" D Q
. . D BLDPI(DGPFROOT,DGPFLABL,DGPFLONG,.DGPFLINE,.DGPFLOUT,DGPFGOUT)
. ;
. ; build array from word-processing multiple:
. I ";DESC;NARR;COMMENT;REASON;"[(";"_DGPFROOT_";") D Q
. . D BLDWP(DGPFROOT,DGPFLABL,.DGPFLINE,.DGPFLOUT,DGPFGOUT)
. ;
. S DGPFCOL=DGPFLONG-$L(DGPFLABL)
. S DGPFPAD=$E($J("",DGPFCOL),1,DGPFCOL)
. S DGPFVAL=DGPFPAD_DGPFLABL_DGPFLOUT(DGPFROOT)
. ;
. S DGPFLINE=DGPFLINE+1
. S @DGPFGOUT@(DGPFLINE,0)=DGPFVAL
Q
;
BLDPI(DGPFROOT,DGPFLABL,DGPFLONG,DGPFLINE,DGPFLOUT,DGPFGOUT) ;
;
; Add each of the nodes from the PRININV array multiple to temp global.
;
; Input:
; DGPFROOT - Name of the field derived from the $TEXT segment below
; DGPFLABL - Label
; DGPFLONG - Contains length of longest label
; DGPFLINE - Line number for incrementing of global array nodes
; DGPFLOUT - Local array of WP text
; DGPFGOUT - (G)lobal (OUT)put - name of ^TMP global built
;
; Output:
; none - build DGPFGOUT - (G)lobal (OUT)put ^TMP global
;
; Temporary variables:
N DGPFSUB ; subscript
N DGPFPAD ; padding for leading spaces for display
N DGPFCOL ; column value for Principal Investigator label
N DGPFVAL ; value from DGPFROOT array node
;
S DGPFCOL=DGPFLONG-$L(DGPFLABL)
S DGPFPAD=$E($J("",DGPFCOL),1,DGPFCOL)
;
S DGPFSUB=""
F S DGPFSUB=$O(DGPFLOUT(DGPFROOT,DGPFSUB)) Q:'DGPFSUB D
. S DGPFVAL=DGPFPAD_DGPFLABL_$G(DGPFLOUT(DGPFROOT,DGPFSUB,0))
. ;
. S DGPFLINE=DGPFLINE+1
. S @DGPFGOUT@(DGPFLINE,0)=DGPFVAL
Q
;
BLDWP(DGPFROOT,DGPFLABL,DGPFLINE,DGPFLOUT,DGPFGOUT) ;build WP array
;
; This procedure adds each of the nodes from the word-processing
; multiple to the temp global (^TMP).
;
; Input:
; DGPFROOT - Name of the field derived from the $TEXT segment below
; DGPFLABL - label
; DGPFLINE - Line number for incrementing of global array nodes
; DGPFLOUT - Local array of WP text to be added to the global array
; DGPFGOUT - (G)lobal (OUT)put - name of ^TMP global built
;
; Output:
; none - build DGPFGOUT - (G)lobal (OUT)put ^TMP global
;
; Temporary variables:
N DGSUB ; subscript value in word processing fields
N DGPFPAD ; Padding as spaces for alignment of headers
N DGPFVAL ; value from DGPFROOT array node
;
S DGPFPAD=" "
;
; insert header for narrative:
S DGPFVAL=DGPFPAD_DGPFLABL
;
S DGPFLINE=DGPFLINE+1
S @DGPFGOUT@(DGPFLINE,0)=DGPFVAL
;
; set each word processing line
S DGSUB=0
F S DGSUB=$O(DGPFLOUT(DGPFROOT,DGSUB)) Q:'DGSUB D
. S DGPFVAL=DGPFPAD_$G(DGPFLOUT(DGPFROOT,DGSUB,0))
. ;
. S DGPFLINE=DGPFLINE+1
. S @DGPFGOUT@(DGPFLINE,0)=DGPFVAL
Q
;
FATXT ; ordered list of fields to be presented to user for Flag Assignment
;;ROOT; ;LABEL;
;;PATIENT; ;Patient Name: ;
;;FLAGNAME; ;Flag Name: ;
;;FLAGTYPE; ;Flag Type: ;
;;CATEGORY; ;Flag Category: ;
;;STATUS; ;Assignment Status: ;
;;INITASSIGN; ;Initial Assignment: ;
;;LASTREVIEW; ;Last Review Date: ;
;;REVIEWDT; ;Next Review Date: ;
;;OWNER; ;Owner Site: ;
;;ORIGSITE; ;Originating Site: ;
;;ACTION; ;Assignment Action: ;
;;ACTIONDT; ;Action Date: ;
;;ENTERBY; ;Entered By: ;
;;APPRVBY; ;Approved By: ;
;;NARR; ;Record Flag Assignment Narrative: ;
;;COMMENT; ;Action Comments: ;
;;QUIT;
Q
;
FMTXT ; ordered list of fields to be presented to user for Flag Management
;;ROOT; ;LABEL;
;;FLAGNAME; ;Flag Name: ;
;;CATEGORY; ;Flag Category: ;
;;FLAGTYPE; ;Flag Type: ;
;;STATUS; ;Flag Status: ;
;;REVFREQ; ;Review Frequency Days: ;
;;NOTIDAYS; ;Notification Days: ;
;;REVGRP; ;Review Mail Group: ;
;;TIUTITLE; ;Progress Note Title: ;
;;ENTERDT; ;Enter/Edit On: ;
;;ENTERBY; ;Enter/Edit By: ;
;;PRININV; ;Principal Investigator(s): ;
;;DESC; ;Flag Description: ;
;;REASON; ;Reason For Flag Enter/Edit: ;
;;QUIT;
Q
DGPFUT4 ;ALB/SAE - PRF UTILITIES CONTINUED ; 6/9/04 1:33pm
+1 ;;5.3;Registration;**554,1015**;Aug 13, 1993;Build 21
+2 ;
+3 ; no direct entry
QUIT
+4 ;
BLDGLOB(DGPFDA,DGPFHX,TXN,DGPFLOUT,DGPFGOUT) ; build global
+1 ;
+2 ; This procedure builds the temporary global for display.
+3 ; It first determines the longest label, then it steps thru the $TEXT
+4 ; list of labels of fields, which control the order of nodes created.
+5 ; For each label it appends the field value then adds the resulting
+6 ; value to the temporary global ^TMP("DGPFARY",$J).
+7 ;
+8 ; Input:
+9 ; DGPFDA - data array
+10 ; - derived from DGPFA if called by Flag Assignment transaction
+11 ; - derived from DGPFLF if called by Flag Management transaction
+12 ; DGPFHX - history array
+13 ; - derived from DGPFAH if called by Flag Assignment transaction
+14 ; - derived from DGPFLH if called by Flag Management transaction
+15 ; TXN - transaction - one of the following:
+16 ; FA - FLAG ASSIGNMENT - Assign Flag
+17 ; FA - FLAG ASSIGNMENT - Edit Flag Assignment
+18 ; FA - FLAG ASSIGNMENT - Change Assignment Ownership
+19 ; FM - FLAG MANAGEMENT - Add New Record Flag
+20 ; FM - FLAG MANAGEMENT - Edit Record Flag
+21 ; DGPFLOUT - (L)ocal (OUT)put array, containing non-WP fields
+22 ; DGPFGOUT - (G)lobal (OUT)put array name to be built.
+23 ;
+24 ; Output:
+25 ; DGPFGOUT - (G)lobal (OUT)put - name of ^TMP global built
+26 ; Contains assignment detail
+27 ; This global is displayed to screen for user.
+28 ;
+29 ; Temporary variables:
+30 ; Array root subscript
NEW DGPFROOT
+31 ; Column value for each display field, stored in text block
NEW DGPFCOL
+32 ; Label of DGPFROOT for display
NEW DGPFLABL
+33 ; Value from DGPFROOT array node
NEW DGPFVAL
+34 ; Holds padded spaces for display alignment
NEW DGPFPAD
+35 ; Offset of text line in text subroutine
NEW DGPFOFST
+36 ; Longest label for later display
NEW DGPFLONG
+37 ; Line number incremented during final global build in SET
NEW DGPFLINE
+38 ; Routine that contains the TEXT from which to read
NEW DGPFRTN
+39 ; value of text line retrieved from TEXT
NEW DGPFTEXT
+40 ; tag at offset of TEXT
NEW DGPFTAG
+41 ; TEXT subroutine to use to acquire data
NEW DGPFSR
+42 ; count of number of times PRININV array has been read
NEW DGPFPICT
+43 ;
+44 SET DGPFLINE=0
+45 SET DGPFRTN=$PIECE(TXN,U)_"TXT"
+46 SET DGPFPICT=0
+47 ;
+48 ; determine longest label - set this value into the variable DGPFLONG:
+49 SET DGPFLONG=1
+50 FOR DGPFOFST=2:1
Begin DoDot:1
+51 SET DGPFTAG=DGPFRTN_"+"_DGPFOFST
SET DGPFTEXT=$TEXT(@DGPFTAG)
+52 SET DGPFROOT=$PIECE(DGPFTEXT,";",3)
+53 IF DGPFROOT=""!(";DESC;NARR;COMMENT;REASON;QUIT;"[(";"_DGPFROOT_";"))
QUIT
+54 IF DGPFROOT="PRININV"
IF '$DATA(DGPFLOUT(DGPFROOT))
QUIT
+55 SET DGPFLABL=$PIECE(DGPFTEXT,";",5)
+56 SET DGPFLONG=$SELECT($LENGTH(DGPFLABL)+1>DGPFLONG:$LENGTH(DGPFLABL)+1,1:DGPFLONG)
End DoDot:1
IF DGPFROOT=""!(DGPFROOT="QUIT")
QUIT
+57 ;
+58 ; step thru the text - this controls the order of display
+59 FOR DGPFOFST=2:1
Begin DoDot:1
+60 SET DGPFTAG=DGPFRTN_"+"_DGPFOFST
SET DGPFTEXT=$TEXT(@DGPFTAG)
+61 SET DGPFROOT=$PIECE(DGPFTEXT,";",3)
+62 SET DGPFLABL=$PIECE(DGPFTEXT,";",5)
+63 IF DGPFROOT=""!(DGPFROOT="QUIT")
QUIT
+64 ;
+65 ; build array from Principal Investigator multiple
+66 IF DGPFROOT="PRININV"
Begin DoDot:2
+67 DO BLDPI(DGPFROOT,DGPFLABL,DGPFLONG,.DGPFLINE,.DGPFLOUT,DGPFGOUT)
End DoDot:2
QUIT
+68 ;
+69 ; build array from word-processing multiple:
+70 IF ";DESC;NARR;COMMENT;REASON;"[(";"_DGPFROOT_";")
Begin DoDot:2
+71 DO BLDWP(DGPFROOT,DGPFLABL,.DGPFLINE,.DGPFLOUT,DGPFGOUT)
End DoDot:2
QUIT
+72 ;
+73 SET DGPFCOL=DGPFLONG-$LENGTH(DGPFLABL)
+74 SET DGPFPAD=$EXTRACT($JUSTIFY("",DGPFCOL),1,DGPFCOL)
+75 SET DGPFVAL=DGPFPAD_DGPFLABL_DGPFLOUT(DGPFROOT)
+76 ;
+77 SET DGPFLINE=DGPFLINE+1
+78 SET @DGPFGOUT@(DGPFLINE,0)=DGPFVAL
End DoDot:1
IF DGPFROOT=""!(DGPFROOT="QUIT")
QUIT
+79 QUIT
+80 ;
BLDPI(DGPFROOT,DGPFLABL,DGPFLONG,DGPFLINE,DGPFLOUT,DGPFGOUT) ;
+1 ;
+2 ; Add each of the nodes from the PRININV array multiple to temp global.
+3 ;
+4 ; Input:
+5 ; DGPFROOT - Name of the field derived from the $TEXT segment below
+6 ; DGPFLABL - Label
+7 ; DGPFLONG - Contains length of longest label
+8 ; DGPFLINE - Line number for incrementing of global array nodes
+9 ; DGPFLOUT - Local array of WP text
+10 ; DGPFGOUT - (G)lobal (OUT)put - name of ^TMP global built
+11 ;
+12 ; Output:
+13 ; none - build DGPFGOUT - (G)lobal (OUT)put ^TMP global
+14 ;
+15 ; Temporary variables:
+16 ; subscript
NEW DGPFSUB
+17 ; padding for leading spaces for display
NEW DGPFPAD
+18 ; column value for Principal Investigator label
NEW DGPFCOL
+19 ; value from DGPFROOT array node
NEW DGPFVAL
+20 ;
+21 SET DGPFCOL=DGPFLONG-$LENGTH(DGPFLABL)
+22 SET DGPFPAD=$EXTRACT($JUSTIFY("",DGPFCOL),1,DGPFCOL)
+23 ;
+24 SET DGPFSUB=""
+25 FOR
SET DGPFSUB=$ORDER(DGPFLOUT(DGPFROOT,DGPFSUB))
IF 'DGPFSUB
QUIT
Begin DoDot:1
+26 SET DGPFVAL=DGPFPAD_DGPFLABL_$GET(DGPFLOUT(DGPFROOT,DGPFSUB,0))
+27 ;
+28 SET DGPFLINE=DGPFLINE+1
+29 SET @DGPFGOUT@(DGPFLINE,0)=DGPFVAL
End DoDot:1
+30 QUIT
+31 ;
BLDWP(DGPFROOT,DGPFLABL,DGPFLINE,DGPFLOUT,DGPFGOUT) ;build WP array
+1 ;
+2 ; This procedure adds each of the nodes from the word-processing
+3 ; multiple to the temp global (^TMP).
+4 ;
+5 ; Input:
+6 ; DGPFROOT - Name of the field derived from the $TEXT segment below
+7 ; DGPFLABL - label
+8 ; DGPFLINE - Line number for incrementing of global array nodes
+9 ; DGPFLOUT - Local array of WP text to be added to the global array
+10 ; DGPFGOUT - (G)lobal (OUT)put - name of ^TMP global built
+11 ;
+12 ; Output:
+13 ; none - build DGPFGOUT - (G)lobal (OUT)put ^TMP global
+14 ;
+15 ; Temporary variables:
+16 ; subscript value in word processing fields
NEW DGSUB
+17 ; Padding as spaces for alignment of headers
NEW DGPFPAD
+18 ; value from DGPFROOT array node
NEW DGPFVAL
+19 ;
+20 SET DGPFPAD=" "
+21 ;
+22 ; insert header for narrative:
+23 SET DGPFVAL=DGPFPAD_DGPFLABL
+24 ;
+25 SET DGPFLINE=DGPFLINE+1
+26 SET @DGPFGOUT@(DGPFLINE,0)=DGPFVAL
+27 ;
+28 ; set each word processing line
+29 SET DGSUB=0
+30 FOR
SET DGSUB=$ORDER(DGPFLOUT(DGPFROOT,DGSUB))
IF 'DGSUB
QUIT
Begin DoDot:1
+31 SET DGPFVAL=DGPFPAD_$GET(DGPFLOUT(DGPFROOT,DGSUB,0))
+32 ;
+33 SET DGPFLINE=DGPFLINE+1
+34 SET @DGPFGOUT@(DGPFLINE,0)=DGPFVAL
End DoDot:1
+35 QUIT
+36 ;
FATXT ; ordered list of fields to be presented to user for Flag Assignment
+1 ;;ROOT; ;LABEL;
+2 ;;PATIENT; ;Patient Name: ;
+3 ;;FLAGNAME; ;Flag Name: ;
+4 ;;FLAGTYPE; ;Flag Type: ;
+5 ;;CATEGORY; ;Flag Category: ;
+6 ;;STATUS; ;Assignment Status: ;
+7 ;;INITASSIGN; ;Initial Assignment: ;
+8 ;;LASTREVIEW; ;Last Review Date: ;
+9 ;;REVIEWDT; ;Next Review Date: ;
+10 ;;OWNER; ;Owner Site: ;
+11 ;;ORIGSITE; ;Originating Site: ;
+12 ;;ACTION; ;Assignment Action: ;
+13 ;;ACTIONDT; ;Action Date: ;
+14 ;;ENTERBY; ;Entered By: ;
+15 ;;APPRVBY; ;Approved By: ;
+16 ;;NARR; ;Record Flag Assignment Narrative: ;
+17 ;;COMMENT; ;Action Comments: ;
+18 ;;QUIT;
+19 QUIT
+20 ;
FMTXT ; ordered list of fields to be presented to user for Flag Management
+1 ;;ROOT; ;LABEL;
+2 ;;FLAGNAME; ;Flag Name: ;
+3 ;;CATEGORY; ;Flag Category: ;
+4 ;;FLAGTYPE; ;Flag Type: ;
+5 ;;STATUS; ;Flag Status: ;
+6 ;;REVFREQ; ;Review Frequency Days: ;
+7 ;;NOTIDAYS; ;Notification Days: ;
+8 ;;REVGRP; ;Review Mail Group: ;
+9 ;;TIUTITLE; ;Progress Note Title: ;
+10 ;;ENTERDT; ;Enter/Edit On: ;
+11 ;;ENTERBY; ;Enter/Edit By: ;
+12 ;;PRININV; ;Principal Investigator(s): ;
+13 ;;DESC; ;Flag Description: ;
+14 ;;REASON; ;Reason For Flag Enter/Edit: ;
+15 ;;QUIT;
+16 QUIT
