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

DGPFUT3.m

Go to the documentation of this file.
  1. DGPFUT3 ;ALB/SAE - PRF UTILITIES CONTINUED ; 6/9/04 5:06pm
  1. ;;5.3;Registration;**554,1015**;Aug 13, 1993;Build 21
  1. ;
  1. Q ; no direct entry
  1. ;
  1. REVIEW(DGPFDA,DGPFHX,DGPFIEN,DGPFOPT,DGPFACT) ; Entry point for review display
  1. ;
  1. ; This is the driver routine for redisplaying entry detail to the user
  1. ; for their review before filing a new or edited PRF Flag or PRF Flag
  1. ; Assignment record.
  1. ;
  1. ; This routine builds the temporary array which is then used to
  1. ; create the temporary global for review by the user.
  1. ;
  1. ; Called from the following options and actions:
  1. ; Option Action Calling Routine
  1. ; RECORD FLAG ASSIGNMENT ASSIGN FLAG AF^DGPFLMA2
  1. ; RECORD FLAG ASSIGNMENT EDIT FLAG ASSIGNMENT EF^DGPFLMA3
  1. ; RECORD FLAG ASSIGNMENT CHANGE ASSIGNMENT OWNERSHIP CO^DGPFLMA4
  1. ; RECORD FLAG MANAGEMENT ADD NEW RECORD FLAG AF^DGPFLF3
  1. ; RECORD FLAG MANAGEMENT EDIT RECORD FLAG EF^DGPFLF5
  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. ; DGPFIEN - IEN of the Flag Assignment for EF and CO
  1. ; - this will be null for all other calls to this routine
  1. ; DGPFOPT - XQY0 variable for option name - used for headers
  1. ; DGPFACT - XQORNOD(0) variable for action name - used for headers
  1. ;
  1. ; Output:
  1. ; none - A temporary global is built and displayed.
  1. ;
  1. ; Temporary variables:
  1. N 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. ;
  1. N DGPFLOUT ; (L)ocal(OUT)put array with values needed to setup global
  1. N DGPFGOUT ; (G)lobal (OUT)put array name. Contains assignment detail
  1. ;
  1. S TXN=$S($P(DGPFOPT,U)["FLAG ASSIGNMENT":"FA",1:"FM")
  1. S TXN=TXN_U_$P($P(DGPFOPT,U),"DGPF ",2)
  1. S TXN=TXN_U_$P(DGPFACT,U,3,4)
  1. ;
  1. S DGPFGOUT=$NA(^TMP("DGPFARY",$J)) K @DGPFGOUT
  1. S DGPFLOUT("ASGMNTIEN")=DGPFIEN
  1. ;
  1. D BLDLOCAL(.DGPFDA,.DGPFHX,TXN,.DGPFLOUT)
  1. D BLDGLOB^DGPFUT4(.DGPFDA,.DGPFHX,TXN,.DGPFLOUT,DGPFGOUT)
  1. D DISPLAY^DGPFUT5(TXN,DGPFGOUT) ; order thru global, display to user
  1. ;
  1. K @DGPFGOUT ; remove temporary global array
  1. Q
  1. ;
  1. BLDLOCAL(DGPFDA,DGPFHX,TXN,DGPFLOUT) ;
  1. ; This procedure builds a local array (DPGFLOUT) of all fields
  1. ;
  1. ; Input:
  1. ; DGPFDA - flag assignment data array
  1. ; DGPFHX - flag assignment history array
  1. ; TXN - transaction containing current option and action
  1. ; DGPFLOUT - Local Output array
  1. ;
  1. ; Output:
  1. ; none
  1. ;
  1. I $P(TXN,U)="FA" D BLDLOCFA(.DGPFDA,.DGPFHX,.DGPFLOUT) ; bld local array
  1. I $P(TXN,U)="FM" D BLDLOCFM(.DGPFDA,.DGPFHX,.DGPFLOUT) ; bld local array
  1. Q
  1. ;
  1. BLDLOCFA(DGPFDA,DGPFHX,DGPFLOUT) ; build (L)ocal (OUT)put array
  1. ;
  1. ; This procedure builds a local array (DPGFLOUT) of all
  1. ; FLAG ASSIGNMENT fields to be presented to the user.
  1. ;
  1. ; Input:
  1. ; DGPFDA - flag assignment data array
  1. ; DGPFHX - flag assignment history array
  1. ; DGPFLOUT - Local Output array
  1. ;
  1. ; Output:
  1. ; DGPFLOUT - (L)ocal (OUT)put array
  1. ;
  1. ; Temporary variables:
  1. N DGPFIEN ; Internal Entry Number
  1. N DGPFPAT ; patient data array
  1. N DGPFFLG ; flag data array
  1. N DGPFAHX ; temporary array for holding last assignment
  1. N DGPFIA ; initial assignment internal value
  1. N DGPFLAST ; last assignment
  1. ;
  1. Q:'$$GETPAT^DGPFUT2($P(DGPFDA("DFN"),U),.DGPFPAT)
  1. Q:'$$GETFLAG^DGPFUT1($P($G(DGPFDA("FLAG")),U),.DGPFFLG)
  1. ;
  1. S DGPFLOUT("PATIENT")=$G(DGPFPAT("NAME"))
  1. S DGPFLOUT("FLAGNAME")=$P($G(DGPFFLG("FLAG")),U)
  1. S DGPFLOUT("FLAGTYPE")=$P($G(DGPFFLG("TYPE")),U,2)
  1. S DGPFLOUT("CATEGORY")=$S(DGPFDA("FLAG")["26.11":"II (LOCAL)",DGPFDA("FLAG")["26.15":"I (NATIONAL)",1:"")
  1. ;
  1. S DGPFIEN=+$G(DGPFDA("STATUS"))
  1. S DGPFLOUT("STATUS")=$$EXTERNAL^DILFD(26.13,.03,"F",DGPFIEN)
  1. ;
  1. ; set initial assignment
  1. S DGPFLOUT("INITASSIGN")=$$FMTE^XLFDT(+$G(DGPFHX("ASSIGNDT")),"5") ; AF
  1. I $G(DGPFLOUT("ASGMNTIEN"))]"" D ; EF and CO actions
  1. . S DGPFIA=$$GETADT^DGPFAAH(DGPFLOUT("ASGMNTIEN"))
  1. . S DGPFLOUT("INITASSIGN")=$$FMTE^XLFDT(+$G(DGPFIA),"5")
  1. ;
  1. ; set last review date
  1. S DGPFLOUT("LASTREVIEW")="N/A" ; AF action
  1. I $G(DGPFLOUT("ASGMNTIEN"))]"" D ; EF and CO actions
  1. . S DGPFLAST=$$GETLAST^DGPFAAH(DGPFLOUT("ASGMNTIEN"))
  1. . S DGPFAHX=$$GETHIST^DGPFAAH(DGPFLAST,.DGPFAHX)
  1. . Q:+$G(DGPFAHX("ASSIGNDT"))=+$G(DGPFIA) ; do not set if = init asgn
  1. . S DGPFLOUT("LASTREVIEW")=$$FMTE^XLFDT(+$G(DGPFAHX("ASSIGNDT")),"5D")
  1. ;
  1. ; set next review date
  1. S DGPFLOUT("REVIEWDT")="N/A"
  1. I $G(DGPFDA("REVIEWDT"))]"" D
  1. . S DGPFLOUT("REVIEWDT")=$$FMTE^XLFDT(+$G(DGPFDA("REVIEWDT")),"5D")
  1. ;
  1. S DGPFIEN=+$G(DGPFDA("OWNER"))_","
  1. S DGPFLOUT("OWNER")=$$GET1^DIQ(4,DGPFIEN,.01,"","","DGERR")
  1. ;
  1. S DGPFIEN=+$G(DGPFDA("ORIGSITE"))_","
  1. S DGPFLOUT("ORIGSITE")=$$GET1^DIQ(4,DGPFIEN,.01,"","","DGERR")
  1. ;
  1. S DGPFIEN=$G(DGPFHX("ACTION"))
  1. S DGPFLOUT("ACTION")=$$EXTERNAL^DILFD(26.14,.03,"F",DGPFIEN)
  1. ;
  1. S DGPFLOUT("ACTIONDT")=$$FMTE^XLFDT($$NOW^XLFDT,"5T")
  1. ;
  1. S DGPFIEN=DUZ_","
  1. S DGPFLOUT("ENTERBY")=$$GET1^DIQ(200,DGPFIEN,.01,"","","DGERR")
  1. ;
  1. ; word processing fields
  1. S DGPFIEN=+$G(DGPFHX("APPRVBY"))_","
  1. S DGPFLOUT("APPRVBY")=$$GET1^DIQ(200,DGPFIEN,.01,"","","DGERR")
  1. ;
  1. M DGPFLOUT("NARR")=DGPFDA("NARR")
  1. M DGPFLOUT("COMMENT")=DGPFHX("COMMENT")
  1. ;
  1. Q
  1. ;
  1. BLDLOCFM(DGPFDA,DGPFHX,DGPFLOUT) ; build (L)ocal (OUT)put array
  1. ;
  1. ; This procedure builds a local array (DPGFLOUT) of all
  1. ; FLAG MANAGEMENT fields to be presented to the user.
  1. ;
  1. ; Input:
  1. ; DGPFDA - flag management data array
  1. ; DGPFHX - flag management history array
  1. ; DGPFLOUT - (L)ocal (OUT)put array
  1. ;
  1. ; Output:
  1. ; DGPFLOUT - (L)ocal (OUT)put array
  1. ;
  1. ; Temporary variables:
  1. N DGPFSUB ; loop control variable
  1. ;
  1. S DGPFLOUT("FLAGNAME")=$P($G(DGPFDA("FLAG")),U,2)
  1. S DGPFLOUT("CATEGORY")="II (LOCAL)"
  1. S DGPFLOUT("FLAGTYPE")=$P($G(DGPFDA("TYPE")),U,2)
  1. S DGPFLOUT("STATUS")=$P($G(DGPFDA("STAT")),U,2)
  1. S DGPFLOUT("REVFREQ")=$P(DGPFDA("REVFREQ"),U)
  1. S DGPFLOUT("NOTIDAYS")=$P(DGPFDA("NOTIDAYS"),U)
  1. S DGPFLOUT("REVGRP")=$P(DGPFDA("REVGRP"),U,2)
  1. S DGPFLOUT("TIUTITLE")=$E($P(DGPFDA("TIUTITLE"),U,2),1,51)
  1. S DGPFLOUT("ENTERDT")=$$FMTE^XLFDT($$NOW^XLFDT,"5T")
  1. S DGPFIEN=DUZ_","
  1. S DGPFLOUT("ENTERBY")=$$GET1^DIQ(200,DGPFIEN,.01,"","","DGERR")
  1. ;
  1. ; principal investigator(s)
  1. S DGPFSUB=""
  1. F S DGPFSUB=$O(DGPFDA("PRININV",DGPFSUB)) Q:DGPFSUB="" D
  1. . Q:$G(DGPFDA("PRININV",DGPFSUB,0))="@"
  1. . S DGPFLOUT("PRININV",DGPFSUB,0)=$P($G(DGPFDA("PRININV",DGPFSUB,0)),U,2)
  1. ;
  1. ; word processing fields
  1. M DGPFLOUT("DESC")=DGPFDA("DESC")
  1. M DGPFLOUT("REASON")=DGPFHX("REASON")
  1. ;
  1. Q