DGPFUT3 ;ALB/SAE - PRF UTILITIES CONTINUED ; 6/9/04 5:06pm
;;5.3;Registration;**554,951**;Aug 13, 1993;Build 135
; Last Edited: SHRPE/SGM, Aug 22, 2018 18:22
;
Q ; no direct entry
; ICR# TYPE DESCRIPTION
;----- ---- ------------------------------------------
; 2055 Sup $$EXTERNAL^DILFD
; 2056 Sup $$GET1^DIQ
; 2171 Sup $$NS^XUAF4
;10103 Sup ^XLFDT: $$FMTE, $$NOW
;10060 Sup File 200 FM Read
;
REVIEW(DGPFDA,DGPFHX,DGPFIEN,DGPFOPT,DGPFACT) ; Entry point for review display
;
; This is the driver routine for redisplaying entry detail to the user
; for their review before filing a new or edited PRF Flag or PRF Flag
; Assignment record.
;
; This routine builds the temporary array which is then used to
; create the temporary global for review by the user.
;
; Called from the following options and actions:
; Option Action Calling Routine
; RECORD FLAG ASSIGNMENT ASSIGN FLAG AF^DGPFLMA2
; RECORD FLAG ASSIGNMENT EDIT FLAG ASSIGNMENT EF^DGPFLMA3
; RECORD FLAG ASSIGNMENT CHANGE ASSIGNMENT OWNERSHIP CO^DGPFLMA4
; RECORD FLAG MANAGEMENT ADD NEW RECORD FLAG AF^DGPFLF3
; RECORD FLAG MANAGEMENT EDIT RECORD FLAG EF^DGPFLF5
; RECORD FLAG RETRANSMISSION <no LM action> RT^DGPFHLF
;
; 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
; DGPFIEN - IEN of the Flag Assignment for EF and CO
; - this will be null for all other calls to this routine
; DGPFOPT - XQY0 variable for option name - used for headers
; DGPFACT - XQORNOD(0) variable for action name - used for headers
;
; Output:
; none - A temporary global is built and displayed.
;
; Temporary variables:
N 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
;
; dg*951
; The variable DGPFIEN is reset in this module to a different meaning
N DGFIEN S DGFIEN=+$G(DGPFIEN)
N DGPFLOUT ; (L)ocal(OUT)put array with values needed to setup global
N DGPFGOUT ; (G)lobal (OUT)put array name. Contains assignment detail
;
S TXN=$S($P(DGPFOPT,U)["FLAG ASSIGNMENT":"FA",1:"FM")
S TXN=TXN_U_$P($P(DGPFOPT,U),"DGPF ",2)
S TXN=TXN_U_$P(DGPFACT,U,3,4)
;
S DGPFGOUT=$NA(^TMP("DGPFARY",$J)) K @DGPFGOUT
S DGPFLOUT("ASGMNTIEN")=DGPFIEN
;
D BLDLOCAL(.DGPFDA,.DGPFHX,TXN,.DGPFLOUT)
D BLDGLOB^DGPFUT4(.DGPFDA,.DGPFHX,TXN,.DGPFLOUT,DGPFGOUT)
D DISPLAY^DGPFUT5(TXN,DGPFGOUT) ; order thru global, display to user
;
K @DGPFGOUT ; remove temporary global array
Q
;
BLDLOCAL(DGPFDA,DGPFHX,TXN,DGPFLOUT) ;
; This procedure builds a local array (DPGFLOUT) of all fields
;
; Input:
; DGPFDA - flag assignment data array
; DGPFHX - flag assignment history array
; TXN - transaction containing current option and action
; DGPFLOUT - Local Output array
;
; Output:
; none
;
I $P(TXN,U)="FA" D BLDLOCFA(.DGPFDA,.DGPFHX,.DGPFLOUT) ; bld local array
I $P(TXN,U)="FM" D BLDLOCFM(.DGPFDA,.DGPFHX,.DGPFLOUT) ; bld local array
Q
;
BLDLOCFA(DGPFDA,DGPFHX,DGPFLOUT) ; build (L)ocal (OUT)put array
;
; This procedure builds a local array (DPGFLOUT) of all
; FLAG ASSIGNMENT fields to be presented to the user.
;
; Input:
; DGPFDA - flag assignment data array
; DGPFHX - flag assignment history array
; DGPFLOUT - Local Output array
;
; Output:
; DGPFLOUT - (L)ocal (OUT)put array
;
; Temporary variables:
N DGERR,DIERR
N DGPFIEN ; Internal Entry Number
N DGPFPAT ; patient data array
N DGPFFLG ; flag data array
N DGPFAHX ; temporary array for holding last assignment
N DGPFIA ; initial assignment internal value
N DGPFLAST ; last assignment
;
Q:'$$GETPAT^DGPFUT2($P(DGPFDA("DFN"),U),.DGPFPAT)
Q:'$$GETFLAG^DGPFUT1($P($G(DGPFDA("FLAG")),U),.DGPFFLG)
;
S DGPFLOUT("PATIENT")=$G(DGPFPAT("NAME"))
S DGPFLOUT("FLAGNAME")=$P($G(DGPFFLG("FLAG")),U)
S DGPFLOUT("FLAGTYPE")=$P($G(DGPFFLG("TYPE")),U,2)
S DGPFLOUT("CATEGORY")=$S(DGPFDA("FLAG")["26.11":"II (LOCAL)",DGPFDA("FLAG")["26.15":"I (NATIONAL)",1:"")
;
S DGPFIEN=+$G(DGPFDA("STATUS"))
S DGPFLOUT("STATUS")=$$EXTERNAL^DILFD(26.13,.03,"F",DGPFIEN)
;
; set initial assignment
S DGPFLOUT("INITASSIGN")=$$FMTE^XLFDT($P($G(DGPFHX("ASSIGNDT")),U),"5") ; AF
I $G(DGPFLOUT("ASGMNTIEN"))]"" D ; EF and CO actions
. S DGPFIA=$$GETADT^DGPFAAH(DGPFLOUT("ASGMNTIEN"))
. S DGPFLOUT("INITASSIGN")=$$FMTE^XLFDT($P($G(DGPFIA),U),"5")
;
; set last review date
S DGPFLOUT("LASTREVIEW")="N/A" ; AF action
I $G(DGPFLOUT("ASGMNTIEN"))]"" D ; EF and CO actions
. S DGPFLAST=$$GETLAST^DGPFAAH(DGPFLOUT("ASGMNTIEN"))
. S DGPFAHX=$$GETHIST^DGPFAAH(DGPFLAST,.DGPFAHX)
. Q:+$G(DGPFAHX("ASSIGNDT"))=+$G(DGPFIA) ; do not set if = init asgn
. S DGPFLOUT("LASTREVIEW")=$$FMTE^XLFDT($P($G(DGPFAHX("ASSIGNDT")),U),"5D")
;
; set next review date
S DGPFLOUT("REVIEWDT")="N/A"
I $G(DGPFDA("REVIEWDT"))]"" D
. S DGPFLOUT("REVIEWDT")=$$FMTE^XLFDT($P($G(DGPFDA("REVIEWDT")),U),"5D")
;
S DGPFIEN=+$G(DGPFDA("OWNER"))_","
S DGPFLOUT("OWNER")=$P($$NS^XUAF4(+DGPFIEN),U)
;
S DGPFIEN=+$G(DGPFDA("ORIGSITE"))_","
S DGPFLOUT("ORIGSITE")=$P($$NS^XUAF4(+DGPFIEN),U)
;
S DGPFIEN=$G(DGPFHX("ACTION"))
S DGPFLOUT("ACTION")=$$EXTERNAL^DILFD(26.14,.03,"F",DGPFIEN)
;
S DGPFLOUT("ACTIONDT")=$$FMTE^XLFDT($$NOW^XLFDT,"5T")
;
S DGPFIEN=DUZ_","
S DGPFLOUT("ENTERBY")=$$GET1^DIQ(200,DGPFIEN,.01,"","","DGERR")
;
; word processing fields
S DGPFIEN=+$G(DGPFHX("APPRVBY"))_","
S DGPFLOUT("APPRVBY")=$$GET1^DIQ(200,DGPFIEN,.01,"","","DGERR")
;
; set DBRS if present, dg*3.5*951
; for EF action, show all DBRS# to display
; for AF action DGFIEN=0
; see DBRS^DGPFUT61 for format of DGPFA("DBRS"_x)
;
I DGPFLOUT("FLAGNAME")="BEHAVIORAL" D
. Q:'$D(DGPFDA("DBRS#"))
. N I,J S (I,J)=0 F S I=$O(DGPFDA("DBRS#",I)) Q:I="" D
. . N X,Y,NM,OTH
. . S NM=$P(DGPFDA("DBRS#",I),U)
. . S OTH=$P(DGPFDA("DBRS OTHER",I),U,2)
. . I OTH="" S OTH="<no value>"
. . S J=J+1
. . S DGPFLOUT("DBRS#",J)=NM
. . S DGPFLOUT("DBRS OTHER",J)=OTH
. . Q
. Q
;
M DGPFLOUT("NARR")=DGPFDA("NARR")
M DGPFLOUT("COMMENT")=DGPFHX("COMMENT")
;
Q
;
BLDLOCFM(DGPFDA,DGPFHX,DGPFLOUT) ; build (L)ocal (OUT)put array
;
; This procedure builds a local array (DPGFLOUT) of all
; FLAG MANAGEMENT fields to be presented to the user.
;
; Input:
; DGPFDA - flag management data array
; DGPFHX - flag management history array
; DGPFLOUT - (L)ocal (OUT)put array
;
; Output:
; DGPFLOUT - (L)ocal (OUT)put array
;
; Temporary variables:
N DGPFSUB ; loop control variable
;
S DGPFLOUT("FLAGNAME")=$P($G(DGPFDA("FLAG")),U,2)
S DGPFLOUT("CATEGORY")="II (LOCAL)"
S DGPFLOUT("FLAGTYPE")=$P($G(DGPFDA("TYPE")),U,2)
S DGPFLOUT("STATUS")=$P($G(DGPFDA("STAT")),U,2)
S DGPFLOUT("REVFREQ")=$P(DGPFDA("REVFREQ"),U)
S DGPFLOUT("NOTIDAYS")=$P(DGPFDA("NOTIDAYS"),U)
S DGPFLOUT("REVGRP")=$P(DGPFDA("REVGRP"),U,2)
S DGPFLOUT("TIUTITLE")=$E($P(DGPFDA("TIUTITLE"),U,2),1,51)
S DGPFLOUT("ENTERDT")=$$FMTE^XLFDT($$NOW^XLFDT,"5T")
S DGPFIEN=DUZ_","
S DGPFLOUT("ENTERBY")=$$GET1^DIQ(200,DGPFIEN,.01,"","","DGERR")
;
; principal investigator(s)
S DGPFSUB=""
F S DGPFSUB=$O(DGPFDA("PRININV",DGPFSUB)) Q:DGPFSUB="" D
. Q:$G(DGPFDA("PRININV",DGPFSUB,0))="@"
. S DGPFLOUT("PRININV",DGPFSUB,0)=$P($G(DGPFDA("PRININV",DGPFSUB,0)),U,2)
;
; word processing fields
M DGPFLOUT("DESC")=DGPFDA("DESC")
M DGPFLOUT("REASON")=DGPFHX("REASON")
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPFUT3 8121 printed Apr 09, 2024@21:54:19 Page 2
DGPFUT3 ;ALB/SAE - PRF UTILITIES CONTINUED ; 6/9/04 5:06pm
+1 ;;5.3;Registration;**554,951**;Aug 13, 1993;Build 135
+2 ; Last Edited: SHRPE/SGM, Aug 22, 2018 18:22
+3 ;
+4 ; no direct entry
QUIT
+5 ; ICR# TYPE DESCRIPTION
+6 ;----- ---- ------------------------------------------
+7 ; 2055 Sup $$EXTERNAL^DILFD
+8 ; 2056 Sup $$GET1^DIQ
+9 ; 2171 Sup $$NS^XUAF4
+10 ;10103 Sup ^XLFDT: $$FMTE, $$NOW
+11 ;10060 Sup File 200 FM Read
+12 ;
REVIEW(DGPFDA,DGPFHX,DGPFIEN,DGPFOPT,DGPFACT) ; Entry point for review display
+1 ;
+2 ; This is the driver routine for redisplaying entry detail to the user
+3 ; for their review before filing a new or edited PRF Flag or PRF Flag
+4 ; Assignment record.
+5 ;
+6 ; This routine builds the temporary array which is then used to
+7 ; create the temporary global for review by the user.
+8 ;
+9 ; Called from the following options and actions:
+10 ; Option Action Calling Routine
+11 ; RECORD FLAG ASSIGNMENT ASSIGN FLAG AF^DGPFLMA2
+12 ; RECORD FLAG ASSIGNMENT EDIT FLAG ASSIGNMENT EF^DGPFLMA3
+13 ; RECORD FLAG ASSIGNMENT CHANGE ASSIGNMENT OWNERSHIP CO^DGPFLMA4
+14 ; RECORD FLAG MANAGEMENT ADD NEW RECORD FLAG AF^DGPFLF3
+15 ; RECORD FLAG MANAGEMENT EDIT RECORD FLAG EF^DGPFLF5
+16 ; RECORD FLAG RETRANSMISSION <no LM action> RT^DGPFHLF
+17 ;
+18 ; Input:
+19 ; DGPFDA - data array
+20 ; - derived from DGPFA if called by Flag Assignment transaction
+21 ; - derived from DGPFLF if called by Flag Management transaction
+22 ; DGPFHX - history array
+23 ; - derived from DGPFAH if called by Flag Assignment transaction
+24 ; - derived from DGPFLH if called by Flag Management transaction
+25 ; DGPFIEN - IEN of the Flag Assignment for EF and CO
+26 ; - this will be null for all other calls to this routine
+27 ; DGPFOPT - XQY0 variable for option name - used for headers
+28 ; DGPFACT - XQORNOD(0) variable for action name - used for headers
+29 ;
+30 ; Output:
+31 ; none - A temporary global is built and displayed.
+32 ;
+33 ; Temporary variables:
+34 ; transaction - one of the following:
NEW TXN
+35 ; FA - FLAG ASSIGNMENT - Assign Flag
+36 ; FA - FLAG ASSIGNMENT - Edit Flag Assignment
+37 ; FA - FLAG ASSIGNMENT - Change Assignment Ownership
+38 ; FM - FLAG MANAGEMENT - Add New Record Flag
+39 ; FM - FLAG MANAGEMENT - Edit Record Flag
+40 ;
+41 ; dg*951
+42 ; The variable DGPFIEN is reset in this module to a different meaning
+43 NEW DGFIEN
SET DGFIEN=+$GET(DGPFIEN)
+44 ; (L)ocal(OUT)put array with values needed to setup global
NEW DGPFLOUT
+45 ; (G)lobal (OUT)put array name. Contains assignment detail
NEW DGPFGOUT
+46 ;
+47 SET TXN=$SELECT($PIECE(DGPFOPT,U)["FLAG ASSIGNMENT":"FA",1:"FM")
+48 SET TXN=TXN_U_$PIECE($PIECE(DGPFOPT,U),"DGPF ",2)
+49 SET TXN=TXN_U_$PIECE(DGPFACT,U,3,4)
+50 ;
+51 SET DGPFGOUT=$NAME(^TMP("DGPFARY",$JOB))
KILL @DGPFGOUT
+52 SET DGPFLOUT("ASGMNTIEN")=DGPFIEN
+53 ;
+54 DO BLDLOCAL(.DGPFDA,.DGPFHX,TXN,.DGPFLOUT)
+55 DO BLDGLOB^DGPFUT4(.DGPFDA,.DGPFHX,TXN,.DGPFLOUT,DGPFGOUT)
+56 ; order thru global, display to user
DO DISPLAY^DGPFUT5(TXN,DGPFGOUT)
+57 ;
+58 ; remove temporary global array
KILL @DGPFGOUT
+59 QUIT
+60 ;
BLDLOCAL(DGPFDA,DGPFHX,TXN,DGPFLOUT) ;
+1 ; This procedure builds a local array (DPGFLOUT) of all fields
+2 ;
+3 ; Input:
+4 ; DGPFDA - flag assignment data array
+5 ; DGPFHX - flag assignment history array
+6 ; TXN - transaction containing current option and action
+7 ; DGPFLOUT - Local Output array
+8 ;
+9 ; Output:
+10 ; none
+11 ;
+12 ; bld local array
IF $PIECE(TXN,U)="FA"
DO BLDLOCFA(.DGPFDA,.DGPFHX,.DGPFLOUT)
+13 ; bld local array
IF $PIECE(TXN,U)="FM"
DO BLDLOCFM(.DGPFDA,.DGPFHX,.DGPFLOUT)
+14 QUIT
+15 ;
BLDLOCFA(DGPFDA,DGPFHX,DGPFLOUT) ; build (L)ocal (OUT)put array
+1 ;
+2 ; This procedure builds a local array (DPGFLOUT) of all
+3 ; FLAG ASSIGNMENT fields to be presented to the user.
+4 ;
+5 ; Input:
+6 ; DGPFDA - flag assignment data array
+7 ; DGPFHX - flag assignment history array
+8 ; DGPFLOUT - Local Output array
+9 ;
+10 ; Output:
+11 ; DGPFLOUT - (L)ocal (OUT)put array
+12 ;
+13 ; Temporary variables:
+14 NEW DGERR,DIERR
+15 ; Internal Entry Number
NEW DGPFIEN
+16 ; patient data array
NEW DGPFPAT
+17 ; flag data array
NEW DGPFFLG
+18 ; temporary array for holding last assignment
NEW DGPFAHX
+19 ; initial assignment internal value
NEW DGPFIA
+20 ; last assignment
NEW DGPFLAST
+21 ;
+22 if '$$GETPAT^DGPFUT2($PIECE(DGPFDA("DFN"),U),.DGPFPAT)
QUIT
+23 if '$$GETFLAG^DGPFUT1($PIECE($GET(DGPFDA("FLAG")),U),.DGPFFLG)
QUIT
+24 ;
+25 SET DGPFLOUT("PATIENT")=$GET(DGPFPAT("NAME"))
+26 SET DGPFLOUT("FLAGNAME")=$PIECE($GET(DGPFFLG("FLAG")),U)
+27 SET DGPFLOUT("FLAGTYPE")=$PIECE($GET(DGPFFLG("TYPE")),U,2)
+28 SET DGPFLOUT("CATEGORY")=$SELECT(DGPFDA("FLAG")["26.11":"II (LOCAL)",DGPFDA("FLAG")["26.15":"I (NATIONAL)",1:"")
+29 ;
+30 SET DGPFIEN=+$GET(DGPFDA("STATUS"))
+31 SET DGPFLOUT("STATUS")=$$EXTERNAL^DILFD(26.13,.03,"F",DGPFIEN)
+32 ;
+33 ; set initial assignment
+34 ; AF
SET DGPFLOUT("INITASSIGN")=$$FMTE^XLFDT($PIECE($GET(DGPFHX("ASSIGNDT")),U),"5")
+35 ; EF and CO actions
IF $GET(DGPFLOUT("ASGMNTIEN"))]""
Begin DoDot:1
+36 SET DGPFIA=$$GETADT^DGPFAAH(DGPFLOUT("ASGMNTIEN"))
+37 SET DGPFLOUT("INITASSIGN")=$$FMTE^XLFDT($PIECE($GET(DGPFIA),U),"5")
End DoDot:1
+38 ;
+39 ; set last review date
+40 ; AF action
SET DGPFLOUT("LASTREVIEW")="N/A"
+41 ; EF and CO actions
IF $GET(DGPFLOUT("ASGMNTIEN"))]""
Begin DoDot:1
+42 SET DGPFLAST=$$GETLAST^DGPFAAH(DGPFLOUT("ASGMNTIEN"))
+43 SET DGPFAHX=$$GETHIST^DGPFAAH(DGPFLAST,.DGPFAHX)
+44 ; do not set if = init asgn
if +$GET(DGPFAHX("ASSIGNDT"))=+$GET(DGPFIA)
QUIT
+45 SET DGPFLOUT("LASTREVIEW")=$$FMTE^XLFDT($PIECE($GET(DGPFAHX("ASSIGNDT")),U),"5D")
End DoDot:1
+46 ;
+47 ; set next review date
+48 SET DGPFLOUT("REVIEWDT")="N/A"
+49 IF $GET(DGPFDA("REVIEWDT"))]""
Begin DoDot:1
+50 SET DGPFLOUT("REVIEWDT")=$$FMTE^XLFDT($PIECE($GET(DGPFDA("REVIEWDT")),U),"5D")
End DoDot:1
+51 ;
+52 SET DGPFIEN=+$GET(DGPFDA("OWNER"))_","
+53 SET DGPFLOUT("OWNER")=$PIECE($$NS^XUAF4(+DGPFIEN),U)
+54 ;
+55 SET DGPFIEN=+$GET(DGPFDA("ORIGSITE"))_","
+56 SET DGPFLOUT("ORIGSITE")=$PIECE($$NS^XUAF4(+DGPFIEN),U)
+57 ;
+58 SET DGPFIEN=$GET(DGPFHX("ACTION"))
+59 SET DGPFLOUT("ACTION")=$$EXTERNAL^DILFD(26.14,.03,"F",DGPFIEN)
+60 ;
+61 SET DGPFLOUT("ACTIONDT")=$$FMTE^XLFDT($$NOW^XLFDT,"5T")
+62 ;
+63 SET DGPFIEN=DUZ_","
+64 SET DGPFLOUT("ENTERBY")=$$GET1^DIQ(200,DGPFIEN,.01,"","","DGERR")
+65 ;
+66 ; word processing fields
+67 SET DGPFIEN=+$GET(DGPFHX("APPRVBY"))_","
+68 SET DGPFLOUT("APPRVBY")=$$GET1^DIQ(200,DGPFIEN,.01,"","","DGERR")
+69 ;
+70 ; set DBRS if present, dg*3.5*951
+71 ; for EF action, show all DBRS# to display
+72 ; for AF action DGFIEN=0
+73 ; see DBRS^DGPFUT61 for format of DGPFA("DBRS"_x)
+74 ;
+75 IF DGPFLOUT("FLAGNAME")="BEHAVIORAL"
Begin DoDot:1
+76 if '$DATA(DGPFDA("DBRS#"))
QUIT
+77 NEW I,J
SET (I,J)=0
FOR
SET I=$ORDER(DGPFDA("DBRS#",I))
if I=""
QUIT
Begin DoDot:2
+78 NEW X,Y,NM,OTH
+79 SET NM=$PIECE(DGPFDA("DBRS#",I),U)
+80 SET OTH=$PIECE(DGPFDA("DBRS OTHER",I),U,2)
+81 IF OTH=""
SET OTH="<no value>"
+82 SET J=J+1
+83 SET DGPFLOUT("DBRS#",J)=NM
+84 SET DGPFLOUT("DBRS OTHER",J)=OTH
+85 QUIT
End DoDot:2
+86 QUIT
End DoDot:1
+87 ;
+88 MERGE DGPFLOUT("NARR")=DGPFDA("NARR")
+89 MERGE DGPFLOUT("COMMENT")=DGPFHX("COMMENT")
+90 ;
+91 QUIT
+92 ;
BLDLOCFM(DGPFDA,DGPFHX,DGPFLOUT) ; build (L)ocal (OUT)put array
+1 ;
+2 ; This procedure builds a local array (DPGFLOUT) of all
+3 ; FLAG MANAGEMENT fields to be presented to the user.
+4 ;
+5 ; Input:
+6 ; DGPFDA - flag management data array
+7 ; DGPFHX - flag management history array
+8 ; DGPFLOUT - (L)ocal (OUT)put array
+9 ;
+10 ; Output:
+11 ; DGPFLOUT - (L)ocal (OUT)put array
+12 ;
+13 ; Temporary variables:
+14 ; loop control variable
NEW DGPFSUB
+15 ;
+16 SET DGPFLOUT("FLAGNAME")=$PIECE($GET(DGPFDA("FLAG")),U,2)
+17 SET DGPFLOUT("CATEGORY")="II (LOCAL)"
+18 SET DGPFLOUT("FLAGTYPE")=$PIECE($GET(DGPFDA("TYPE")),U,2)
+19 SET DGPFLOUT("STATUS")=$PIECE($GET(DGPFDA("STAT")),U,2)
+20 SET DGPFLOUT("REVFREQ")=$PIECE(DGPFDA("REVFREQ"),U)
+21 SET DGPFLOUT("NOTIDAYS")=$PIECE(DGPFDA("NOTIDAYS"),U)
+22 SET DGPFLOUT("REVGRP")=$PIECE(DGPFDA("REVGRP"),U,2)
+23 SET DGPFLOUT("TIUTITLE")=$EXTRACT($PIECE(DGPFDA("TIUTITLE"),U,2),1,51)
+24 SET DGPFLOUT("ENTERDT")=$$FMTE^XLFDT($$NOW^XLFDT,"5T")
+25 SET DGPFIEN=DUZ_","
+26 SET DGPFLOUT("ENTERBY")=$$GET1^DIQ(200,DGPFIEN,.01,"","","DGERR")
+27 ;
+28 ; principal investigator(s)
+29 SET DGPFSUB=""
+30 FOR
SET DGPFSUB=$ORDER(DGPFDA("PRININV",DGPFSUB))
if DGPFSUB=""
QUIT
Begin DoDot:1
+31 if $GET(DGPFDA("PRININV",DGPFSUB,0))="@"
QUIT
+32 SET DGPFLOUT("PRININV",DGPFSUB,0)=$PIECE($GET(DGPFDA("PRININV",DGPFSUB,0)),U,2)
End DoDot:1
+33 ;
+34 ; word processing fields
+35 MERGE DGPFLOUT("DESC")=DGPFDA("DESC")
+36 MERGE DGPFLOUT("REASON")=DGPFHX("REASON")
+37 ;
+38 QUIT
