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

DGPFRPI2.m

Go to the documentation of this file. 
  1. DGPFRPI2 ;ALB/RBS - PRF PRINCIPAL INVEST REPORT CONT. ; 6/14/04 10:39am
  1.  ;;5.3;Registration;**554,1015**;Aug 13, 1993;Build 21
  1.  ;
  1.  ;This routine will be used to display/print all patient assignments
  1.  ;for a Principal Investigator assigned to the Research record flag.
  1.  ;
  1.  ;- no direct entry
  1.  QUIT
  1.  ;
  1. PRINT(DGSORT,DGLIST) ;output report
  1.  ;  Input:
  1.  ;      DGSORT - array of user selected report parameters
  1.  ;      DGLIST - temp global name used for report list
  1.  ;               ^TMP("DGPFRPI1",$J)
  1.  ;
  1.  ; Output: Formatted report to user selected device
  1.  ;
  1.  N DGBEG    ;sort beginning date
  1.  N DGDFN    ;ien of patient
  1.  N DGDT     ;date time report printed
  1.  N DGFG     ;flag name
  1.  N DGEND    ;sort ending date
  1.  N DGHSTR   ;header string var
  1.  N DGHSTR1  ;header string var
  1.  N DGHSTR2  ;header string var
  1.  N DGLINE   ;string of hyphens (80) for report header format
  1.  N DGLN     ;loop var
  1.  N DGPNAM   ;patient name
  1.  N DGODFN   ;loop var flag
  1.  N DGOFG    ;name switch flag
  1.  N DGOPISTR ;pi name switch flag
  1.  N DGPAGE   ;page counter
  1.  N DGPISTR  ;pi name string for sub-header display
  1.  N DGQ      ;quit flag
  1.  N DGSTR    ;string of detail line to display
  1.  N X,Y
  1.  ;
  1.  S DGHSTR="PATIENT RECORD FLAGS"
  1.  S DGHSTR1="ASSIGNMENTS BY PRINCIPAL INVESTIGATOR REPORT"
  1.  I DGSORT("DGPRINC")="A" S DGHSTR2="(A)ll Principal Investigators"
  1.  E  S DGHSTR2="(S)ingle Principal Investigator: "_$P(DGSORT("DGPRINC"),U,2)
  1.  S DGDT=$P($$FMTE^XLFDT($$NOW^XLFDT,"T"),":",1,2)
  1.  S DGBEG=$$FDATE^VALM1(DGSORT("DGBEG"))
  1.  S DGEND=$$FDATE^VALM1(DGSORT("DGEND"))
  1.  S (DGQ,DGPAGE)=0,$P(DGLINE,"-",81)=""
  1.  ;
  1.  I $O(@DGLIST@(""))="" D  Q
  1.  . D HEAD
  1.  . W !!,"   >>> No Record Flag Assignments were found using the report criteria.",!
  1.  ;
  1.  ; loop and print report
  1.  S (DGDFN,DGFG,DGLN,DGPISTR,DGPNAM,DGODFN,DGOFG,DGOPISTR,DGSTR)=""
  1.  ;
  1.  D HEAD
  1.  F  S DGFG=$O(@DGLIST@(DGFG)) Q:DGFG=""  D  Q:DGQ
  1.  . S DGPISTR=$$PISTR(DGFG)
  1.  . I $Y>(IOSL-10) D PAUSE(.DGQ) Q:DGQ  D HEAD,HEAD1,HEAD2,HEAD3 S DGOFG=DGFG,DGOPISTR=DGPISTR
  1.  . I DGOFG'=DGFG D
  1.  . . W:DGOPISTR]"" !! D HEAD1,HEAD2,HEAD3 S DGOFG=DGFG,DGOPISTR=DGPISTR
  1.  . S DGPNAM=0  ;starts looping after "0" princ invest node
  1.  . F  S DGPNAM=$O(@DGLIST@(DGFG,DGPNAM)) Q:DGPNAM=""  D  Q:DGQ
  1.  . . ; print patient detail line
  1.  . . S DGODFN=""
  1.  . . F  S DGDFN=$O(@DGLIST@(DGFG,DGPNAM,DGDFN)) Q:DGDFN=""  D  Q:DGQ
  1.  . . . S DGLN=""
  1.  . . . F  S DGLN=$O(@DGLIST@(DGFG,DGPNAM,DGDFN,DGLN)) Q:DGLN=""  D  Q:DGQ
  1.  . . . . I $Y>(IOSL-3) D PAUSE(.DGQ) Q:DGQ  D HEAD,HEAD1,HEAD2,HEAD3 S DGODFN=""
  1.  . . . . S DGSTR=$G(@DGLIST@(DGFG,DGPNAM,DGDFN,DGLN))
  1.  . . . . W !
  1.  . . . . I DGODFN'=DGDFN S DGODFN=DGDFN D  ;only print name once
  1.  . . . . . W $E(DGPNAM,1,16),?18,$P(DGSTR,U)
  1.  . . . . W ?30,$P(DGSTR,U,2),?48,$P(DGSTR,U,3),?60,$P(DGSTR,U,4),?71,$P(DGSTR,U,5)
  1.  ;
  1.  ;Shutdown if stop task requested
  1.  I DGQ W:$D(ZTQUEUED) !!,"REPORT STOPPED AT USER REQUEST" Q
  1.  ;
  1.  W !!,"<End of Report>"
  1.  Q
  1.  ;
  1. PAUSE(DGQ) ; pause screen display
  1.  ;  Input: 
  1.  ;      DGQ - var used to quit report processing to user CRT
  1.  ; Output:
  1.  ;      DGQ - passed by reference - 0 = Continue, 1 = Quit
  1.  ;
  1.  I $G(DGPAGE)>0,$E(IOST,1,2)="C-" K DIR S DIR(0)="E" D ^DIR K DIR S:+Y=0 DGQ=1
  1.  Q
  1.  ;
  1.  ;
  1.  I $D(ZTQUEUED),$$S^%ZTLOAD S (ZTSTOP,DGQ)=1 Q
  1.  W:'($E(IOST,1,2)'="C-"&'DGPAGE) @IOF
  1.  ;
  1.  S DGPAGE=$G(DGPAGE)+1
  1.  W !?(IOM/2)-($L(DGHSTR)/2),DGHSTR
  1.  W !?(IOM/2)-($L(DGHSTR1)/2),DGHSTR1
  1.  W ?68,"Page: ",$G(DGPAGE)
  1.  W !,"Date Range: ",DGBEG_" to "_DGEND
  1.  W ?50,"Printed: ",DGDT
  1.  W !,"Sorted By: ",DGHSTR2
  1.  W !,DGLINE,!
  1.  Q
  1.  ;
  1. HEAD1 W !,"Flag Name: ",$G(DGFG)," - Category II (Local)"
  1.  Q
  1.  ;
  1. HEAD2 W !,"Principal Investigator: "
  1.  ;    <---- length = 24 ----->
  1.  ; check string length so we don't wrap on screen/printer (80) max
  1.  I $L(DGPISTR)'>55 W ?24,DGPISTR
  1.  E  D
  1.  . N X,Y
  1.  . S X=""
  1.  . F Y=1:1:$L(DGPISTR,"; ") D
  1.  . . I $L(X_$P(DGPISTR,"; ",Y))>53 W ?24,X,";" S X="" W !
  1.  . . S:X]"" X=X_"; "
  1.  . . S X=X_$P(DGPISTR,"; ",Y)
  1.  . W ?24,X
  1.  Q
  1.  ;
  1. HEAD3 W !!,"PATIENT",?18,"SSN",?30,"ACTION",?48,"ACTION DT",?60,"REVIEW DT",?71,"STATUS"
  1.  W !,"================",?18,"==========",?30,"================",?48,"=========",?60,"=========",?71,"========="
  1.  Q
  1.  ;
  1. PISTR(DGFG) ;string Principal Investigators together for sub-header display
  1.  ;
  1.  ;  Input:
  1.  ;      DGFG - flag name subscript
  1.  ;
  1.  ; Output:
  1.  ;  Function Value - string of Principal Investigator names
  1.  ;     i.e. -  "Johnny Cash; Bob Smith; Pete Best; ect..."
  1.  ;
  1.  N DGRSLT   ;returned function value
  1.  N DGPI     ;principal investigator person ien
  1.  S DGRSLT=""
  1.  ;
  1.  I $O(@DGLIST@(DGFG,0,""))="" D
  1.  . S DGRSLT="No Principal Investigator names on file"
  1.  ;
  1.  I $O(@DGLIST@(DGFG,0,"")) D
  1.  . S DGPI=""
  1.  . F  S DGPI=$O(@DGLIST@(DGFG,0,DGPI)) Q:DGPI=""  D  Q:$L(DGRSLT)>450
  1.  . . S:DGRSLT]"" DGRSLT=DGRSLT_"; "
  1.  . . S DGRSLT=DGRSLT_$G(@DGLIST@(DGFG,0,DGPI))
  1.  Q DGRSLT