DGPFUT3 ;ALB/SAE - PRF UTILITIES CONTINUED ; 6/9/04 5:06pm
;;5.3;Registration;**554,1015**;Aug 13, 1993;Build 21
;
Q ; no direct entry
;
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
;
; 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
;
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 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(+$G(DGPFHX("ASSIGNDT")),"5") ; AF
I $G(DGPFLOUT("ASGMNTIEN"))]"" D ; EF and CO actions
. S DGPFIA=$$GETADT^DGPFAAH(DGPFLOUT("ASGMNTIEN"))
. S DGPFLOUT("INITASSIGN")=$$FMTE^XLFDT(+$G(DGPFIA),"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(+$G(DGPFAHX("ASSIGNDT")),"5D")
;
; set next review date
S DGPFLOUT("REVIEWDT")="N/A"
I $G(DGPFDA("REVIEWDT"))]"" D
. S DGPFLOUT("REVIEWDT")=$$FMTE^XLFDT(+$G(DGPFDA("REVIEWDT")),"5D")
;
S DGPFIEN=+$G(DGPFDA("OWNER"))_","
S DGPFLOUT("OWNER")=$$GET1^DIQ(4,DGPFIEN,.01,"","","DGERR")
;
S DGPFIEN=+$G(DGPFDA("ORIGSITE"))_","
S DGPFLOUT("ORIGSITE")=$$GET1^DIQ(4,DGPFIEN,.01,"","","DGERR")
;
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")
;
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
DGPFUT3 ;ALB/SAE - PRF UTILITIES CONTINUED ; 6/9/04 5:06pm
+1 ;;5.3;Registration;**554,1015**;Aug 13, 1993;Build 21
+2 ;
+3 ; no direct entry
QUIT
+4 ;
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 ;
+17 ; Input:
+18 ; DGPFDA - data array
+19 ; - derived from DGPFA if called by Flag Assignment transaction
+20 ; - derived from DGPFLF if called by Flag Management transaction
+21 ; DGPFHX - history array
+22 ; - derived from DGPFAH if called by Flag Assignment transaction
+23 ; - derived from DGPFLH if called by Flag Management transaction
+24 ; DGPFIEN - IEN of the Flag Assignment for EF and CO
+25 ; - this will be null for all other calls to this routine
+26 ; DGPFOPT - XQY0 variable for option name - used for headers
+27 ; DGPFACT - XQORNOD(0) variable for action name - used for headers
+28 ;
+29 ; Output:
+30 ; none - A temporary global is built and displayed.
+31 ;
+32 ; Temporary variables:
+33 ; transaction - one of the following:
NEW TXN
+34 ; FA - FLAG ASSIGNMENT - Assign Flag
+35 ; FA - FLAG ASSIGNMENT - Edit Flag Assignment
+36 ; FA - FLAG ASSIGNMENT - Change Assignment Ownership
+37 ; FM - FLAG MANAGEMENT - Add New Record Flag
+38 ; FM - FLAG MANAGEMENT - Edit Record Flag
+39 ;
+40 ; (L)ocal(OUT)put array with values needed to setup global
NEW DGPFLOUT
+41 ; (G)lobal (OUT)put array name. Contains assignment detail
NEW DGPFGOUT
+42 ;
+43 SET TXN=$SELECT($PIECE(DGPFOPT,U)["FLAG ASSIGNMENT":"FA",1:"FM")
+44 SET TXN=TXN_U_$PIECE($PIECE(DGPFOPT,U),"DGPF ",2)
+45 SET TXN=TXN_U_$PIECE(DGPFACT,U,3,4)
+46 ;
+47 SET DGPFGOUT=$NAME(^TMP("DGPFARY",$JOB))
KILL @DGPFGOUT
+48 SET DGPFLOUT("ASGMNTIEN")=DGPFIEN
+49 ;
+50 DO BLDLOCAL(.DGPFDA,.DGPFHX,TXN,.DGPFLOUT)
+51 DO BLDGLOB^DGPFUT4(.DGPFDA,.DGPFHX,TXN,.DGPFLOUT,DGPFGOUT)
+52 ; order thru global, display to user
DO DISPLAY^DGPFUT5(TXN,DGPFGOUT)
+53 ;
+54 ; remove temporary global array
KILL @DGPFGOUT
+55 QUIT
+56 ;
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 ; Internal Entry Number
NEW DGPFIEN
+15 ; patient data array
NEW DGPFPAT
+16 ; flag data array
NEW DGPFFLG
+17 ; temporary array for holding last assignment
NEW DGPFAHX
+18 ; initial assignment internal value
NEW DGPFIA
+19 ; last assignment
NEW DGPFLAST
+20 ;
+21 IF '$$GETPAT^DGPFUT2($PIECE(DGPFDA("DFN"),U),.DGPFPAT)
QUIT
+22 IF '$$GETFLAG^DGPFUT1($PIECE($GET(DGPFDA("FLAG")),U),.DGPFFLG)
QUIT
+23 ;
+24 SET DGPFLOUT("PATIENT")=$GET(DGPFPAT("NAME"))
+25 SET DGPFLOUT("FLAGNAME")=$PIECE($GET(DGPFFLG("FLAG")),U)
+26 SET DGPFLOUT("FLAGTYPE")=$PIECE($GET(DGPFFLG("TYPE")),U,2)
+27 SET DGPFLOUT("CATEGORY")=$SELECT(DGPFDA("FLAG")["26.11":"II (LOCAL)",DGPFDA("FLAG")["26.15":"I (NATIONAL)",1:"")
+28 ;
+29 SET DGPFIEN=+$GET(DGPFDA("STATUS"))
+30 SET DGPFLOUT("STATUS")=$$EXTERNAL^DILFD(26.13,.03,"F",DGPFIEN)
+31 ;
+32 ; set initial assignment
+33 ; AF
SET DGPFLOUT("INITASSIGN")=$$FMTE^XLFDT(+$GET(DGPFHX("ASSIGNDT")),"5")
+34 ; EF and CO actions
IF $GET(DGPFLOUT("ASGMNTIEN"))]""
Begin DoDot:1
+35 SET DGPFIA=$$GETADT^DGPFAAH(DGPFLOUT("ASGMNTIEN"))
+36 SET DGPFLOUT("INITASSIGN")=$$FMTE^XLFDT(+$GET(DGPFIA),"5")
End DoDot:1
+37 ;
+38 ; set last review date
+39 ; AF action
SET DGPFLOUT("LASTREVIEW")="N/A"
+40 ; EF and CO actions
IF $GET(DGPFLOUT("ASGMNTIEN"))]""
Begin DoDot:1
+41 SET DGPFLAST=$$GETLAST^DGPFAAH(DGPFLOUT("ASGMNTIEN"))
+42 SET DGPFAHX=$$GETHIST^DGPFAAH(DGPFLAST,.DGPFAHX)
+43 ; do not set if = init asgn
IF +$GET(DGPFAHX("ASSIGNDT"))=+$GET(DGPFIA)
QUIT
+44 SET DGPFLOUT("LASTREVIEW")=$$FMTE^XLFDT(+$GET(DGPFAHX("ASSIGNDT")),"5D")
End DoDot:1
+45 ;
+46 ; set next review date
+47 SET DGPFLOUT("REVIEWDT")="N/A"
+48 IF $GET(DGPFDA("REVIEWDT"))]""
Begin DoDot:1
+49 SET DGPFLOUT("REVIEWDT")=$$FMTE^XLFDT(+$GET(DGPFDA("REVIEWDT")),"5D")
End DoDot:1
+50 ;
+51 SET DGPFIEN=+$GET(DGPFDA("OWNER"))_","
+52 SET DGPFLOUT("OWNER")=$$GET1^DIQ(4,DGPFIEN,.01,"","","DGERR")
+53 ;
+54 SET DGPFIEN=+$GET(DGPFDA("ORIGSITE"))_","
+55 SET DGPFLOUT("ORIGSITE")=$$GET1^DIQ(4,DGPFIEN,.01,"","","DGERR")
+56 ;
+57 SET DGPFIEN=$GET(DGPFHX("ACTION"))
+58 SET DGPFLOUT("ACTION")=$$EXTERNAL^DILFD(26.14,.03,"F",DGPFIEN)
+59 ;
+60 SET DGPFLOUT("ACTIONDT")=$$FMTE^XLFDT($$NOW^XLFDT,"5T")
+61 ;
+62 SET DGPFIEN=DUZ_","
+63 SET DGPFLOUT("ENTERBY")=$$GET1^DIQ(200,DGPFIEN,.01,"","","DGERR")
+64 ;
+65 ; word processing fields
+66 SET DGPFIEN=+$GET(DGPFHX("APPRVBY"))_","
+67 SET DGPFLOUT("APPRVBY")=$$GET1^DIQ(200,DGPFIEN,.01,"","","DGERR")
+68 ;
+69 MERGE DGPFLOUT("NARR")=DGPFDA("NARR")
+70 MERGE DGPFLOUT("COMMENT")=DGPFHX("COMMENT")
+71 ;
+72 QUIT
+73 ;
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
