- 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