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

DDSPRNT.m

Go to the documentation of this file. 
  1. DDSPRNT ;SFISC/MKO-PRINT A FORM ;02:51 PM  18 Nov 1994
  1.  ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
  1.  ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
  1.  ;;Licensed under the terms of the Apache License, Version 2.0.
  1.  ;
  1.  I '$D(DIFM) N DIFM S DIFM=1 D INIZE^DIEFU
  1.  ;
  1.  N DDSFORM,DDSPBRK
  1.  D SELFORM(.DDSFORM) Q:DDSFORM=-1
  1.  D PAGEBRK(.DDSPBRK) Q:$D(DDSPBRK)[0
  1.  ;
  1.  ;Device
  1.  S %ZIS=$S($D(^%ZTSK):"Q",1:"")
  1.  W ! D ^%ZIS K %ZIS I $G(POP) K POP Q
  1.  K POP
  1.  ;
  1.  ;Queue report
  1.  I $D(IO("Q")),$D(^%ZTSK) D  G END
  1.  . S ZTRTN="PRINT^DDSPRNT"
  1.  . S ZTDESC="Report of Form "_$P(DDSFORM,U,2)
  1.  . N I F I="DDSFORM","DDSFORM(0)","DDSPBRK" S ZTSAVE(I)=""
  1.  . D ^%ZTLOAD
  1.  . I $D(ZTSK)#2 W !,"Report queued!",!,"Task number: "_$G(ZTSK),!
  1.  . E  W !,"Report canceled!",!
  1.  . K ZTSK
  1.  . S IOP="HOME" D ^%ZIS
  1.  ;
  1.  U IO
  1.  ;
  1. PRINT ;Entry point for queued reports
  1.  N DDSBK,DDSCOL1,DDSCOL2,DDSCOL3,DDSCRT,DDSFILE
  1.  N DDSHLIN,DDSHBK,DDSPAGE,DDSQUE
  1.  N DX,DY,X,Y
  1.  ;
  1.  I '$D(DIFM) N DIFM S DIFM=1 D INIZE^DIEFU
  1.  D INIT
  1.  D @("HDR"_(2-DDSCRT))
  1.  D FORM,END
  1.  Q
  1.  ;
  1. FORM ;Form data
  1.  W !
  1.  ;
  1.  ;Description
  1.  D WP($NA(^DIST(.403,+DDSFORM,15))) Q:$D(DIRUT)
  1.  ;
  1.  ;Other properties
  1.  D W("PRIMARY FILE: "_$P(DDSFORM(0),U,8),9) Q:$D(DIRUT)
  1.  W ?49,"READ ACCESS: "_$P(DDSFORM(0),U,2)
  1.  D W("DATE CREATED: "_$$EXTERNAL^DILFD(.403,4,"",$P(DDSFORM(0),U,5)),9) Q:$D(DIRUT)
  1.  W ?48,"WRITE ACCESS: "_$P(DDSFORM(0),U,3)
  1.  D W("DATE LAST USED: "_$$EXTERNAL^DILFD(.403,5,"",$P(DDSFORM(0),U,6)),7) Q:$D(DIRUT)
  1.  W ?53,"CREATOR: "_$P(DDSFORM(0),U,4)
  1.  D W() Q:$D(DIRUT)
  1.  ;
  1.  I $P(DDSFORM(0),U,7)]"" D W("TITLE: "_$P(DDSFORM(0),U,7),16) Q:$D(DIRUT)
  1.  I $P($G(^DIST(.403,+DDSFORM,21)),U)]"" D W("RECORD SELECTION PAGE: "_$P(^(21),U)) Q:$D(DIRUT)
  1.  ;
  1.  I $X D W() Q:$D(DIRUT)
  1.  S X=$G(^DIST(.403,+DDSFORM,11))
  1.  I X]"" D W("PRE ACTION:",11) Q:$D(DIRUT)  D PCOL(X,23)
  1.  S X=$G(^DIST(.403,+DDSFORM,12))
  1.  I X]"" D W("POST ACTION:",10) Q:$D(DIRUT)  D PCOL(X,23)
  1.  S X=$G(^DIST(.403,+DDSFORM,14))
  1.  I X]"" D W("POST SAVE:",12) Q:$D(DIRUT)  D PCOL(X,23)
  1.  S X=$G(^DIST(.403,+DDSFORM,20))
  1.  I X]"" D W("DATA VALIDATION:",6) Q:$D(DIRUT)  D PCOL(X,23)
  1.  K DDSFORM(0)
  1.  ;
  1.  ;Loop through all pages
  1.  I $X D W() Q:$D(DIRUT)
  1.  Q:'$O(^DIST(.403,+DDSFORM,40,0))
  1.  ;
  1.  N DDSPG,DDSPGN
  1.  S DDSPGN="",DDSPFRST=1
  1.  F  S DDSPGN=$O(^DIST(.403,+DDSFORM,40,"B",DDSPGN)) Q:DDSPGN=""!$D(DIRUT)  S DDSPG=0 F  S DDSPG=$O(^DIST(.403,+DDSFORM,40,"B",DDSPGN,DDSPG)) Q:'DDSPG!$D(DIRUT)  D PAGE^DDSPRNT1
  1.  K DDSPFRST Q:$D(DIRUT)
  1.  ;
  1.  D:$D(DDSHBK) HBLKS^DDSPRNT1
  1.  Q
  1.  ;
  1. WR(DDSLAB,DDSVAL,DDSFLG) ;Write label and value
  1.  I DDSVAL="",'$G(DDSFLG) Q
  1.  ;
  1.  D W() Q:$D(DIRUT)
  1.  W ?DDSCOL2,DDSLAB
  1.  ;
  1.  I $X>DDSCOL3 N DDSCOL3 S DDSCOL3=$X+1
  1.  D PCOL(DDSVAL,DDSCOL3)
  1.  Q
  1.  ;
  1. PCOL(DDSVAL,DDSCOL) ;Print DDSVAL
  1.  N DDSWIDTH,DDSIND
  1.  S DDSWIDTH=IOM-DDSCOL-1
  1.  F DDSIND=1:DDSWIDTH:$L(DDSVAL) D  Q:$D(DIRUT)
  1.  . I DDSIND>1 D W() Q:$D(DIRUT)
  1.  . W ?DDSCOL,$E(DDSVAL,DDSIND,DDSIND+DDSWIDTH-1)
  1.  Q
  1.  ;
  1. WP(DDSWP,DIWL,DDSLF) ;Print text in array @DDSWP
  1.  ;DDSLF [ A : LF after (def)
  1.  ;        B : LF feed before
  1.  ;
  1.  Q:'$P($G(@DDSWP@(0)),U,3)
  1.  N DIW,DIWF,DIWI,DIWR,DIWT,DIWTC,DIWX,DN
  1.  N DDSI,DDSCNT,I,X,Z
  1.  ;
  1.  K ^UTILITY($J,"W")
  1.  S:'$G(DIWL) DIWL=1
  1.  S DIWR=IOM-1
  1.  S:'$D(DDSLF) DDSLF="A"
  1.  ;
  1.  S DDSCNT=$P($G(@DDSWP@(0)),U,3)
  1.  I DDSCNT D
  1.  . F DDSI=1:1:DDSCNT I $D(@DDSWP@(DDSI,0))#2 S X=^(0) D ^DIWP
  1.  . ;
  1.  . I DDSLF'["B" D
  1.  .. W ?DIWL-1,$G(^UTILITY($J,"W",DIWL,1,0))
  1.  .. S DDSCNT=1
  1.  . E  S DDSCNT=0
  1.  . F  S DDSCNT=$O(^UTILITY($J,"W",DIWL,DDSCNT)) Q:'DDSCNT!$D(DIRUT)  D
  1.  .. D W($G(^UTILITY($J,"W",DIWL,DDSCNT,0)),DIWL-1)
  1.  ;
  1.  K ^UTILITY($J,"W")
  1.  D:DDSLF["A" W()
  1.  Q
  1.  ;
  1. W(DDSSTR,DDSCOL) ;Write DDSSTR
  1.  I $Y+3'<IOSL D HEADER Q:$D(DIRUT)
  1.  W !?+$G(DDSCOL),$G(DDSSTR)
  1.  Q
  1.  ;
  1.  I DDSCRT D  Q:$D(DIRUT)
  1.  . N DIR,X,Y
  1.  . S DIR(0)="E" W ! D ^DIR
  1.  I DDSQUE,$$S^%ZTLOAD S (ZTSTOP,DIRUT)=1 Q
  1.  ;
  1. HDR1 ;First header for CRTs
  1.  W @IOF
  1.  ;
  1. HDR2 ;First header for non-CRTs
  1.  ;
  1.  S DDSPAGE=$G(DDSPAGE)+1
  1.  W "FORM LISTING - "_$P(DDSFORM,U,2)_" (#"_+DDSFORM_")"
  1.  W !,"FILE: "_DDSFILE
  1.  W ?(IOM-$L(DDSHLIN)-$L(DDSPAGE)-1),DDSHLIN_DDSPAGE
  1.  W !,$TR($J("",IOM-1)," ","-")
  1.  Q
  1.  ;
  1. SELFORM(DDSFORM) ;Select form
  1.  N %,%W,%Y,C,I,Q,DDH,DIC,X,Y
  1.  S DIC="^DIST(.403,",DIC(0)="QEAMZ"
  1.  D ^DIC K DIC
  1.  S DDSFORM=Y,DDSFORM(0)=$G(Y(0))
  1.  Q
  1.  ;
  1. PAGEBRK(DDSPBRK) ;Prompt
  1.  N DIR,DIRUT,DUOUT,DTOUT,DIROUT,X,Y
  1.  S DIR(0)="YO"
  1.  S DIR("A")="Start each page of the form on a new page"
  1.  S DIR("B")="Yes"
  1.  W ! D ^DIR Q:$D(DIRUT)
  1.  S DDSPBRK=Y
  1.  Q
  1.  ;
  1. INIT ;Setup
  1.  N %,%H,X,Y
  1.  S %H=$H D YX^%DTC
  1.  S DDSHLIN=$P(Y,"@")_"  "_$P($P(Y,"@",2),":",1,2)_"    PAGE "
  1.  S DDSFILE=$P(DDSFORM(0),U,8)
  1.  I DDSFILE,$D(^DIC(DDSFILE,0))#2 S DDSFILE=$P(^(0),U)_" (#"_DDSFILE_")"
  1.  E  S DDSFILE=""
  1.  S DDSCRT=$E(IOST,1,2)="C-"
  1.  S DDSQUE=$D(ZTQUEUED)
  1.  Q
  1.  ;
  1. END ;Finish up
  1.  I $D(ZTQUEUED) S ZTREQ="@"
  1.  E  X $G(^%ZIS("C"))
  1.  K DIRUT,DUOUT,DTOUT
  1.  Q