INHDWPR.m

INHDWPR ;JSH; 8 Apr 94 17:02;Print Utilities 

 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001

 ;COPYRIGHT 1991-2000 SAIC

 ;

PRTLIST ;Print specified entries from a file using a template

 ;DIC = file # or reference

 ;DA(n)=""  = entry #s to print

 ;DR  = template name

 N %,I,L,C,Q,DK,DPP,DI,Y,DX,DIK

 ;Build sort array

 S %=0 K ^UTILITY(U,$J) F I=0:0 S I=$O(DA(I)) Q:'I   S %=%+1,^UTILITY(U,$J,%,I)=""

P1 I +DIC Q:'$D(^DIC(DIC,0,"GL"))  S DIC=^DIC(DIC,0,"GL")

 I @("'$D("_DIC_"0))") Q

 S Y=$P(^(0),U,2),DI=DIC,DPP(1)=+Y_"^^^@",DK=+Y,Q="""",C=",",L=0

 S DPP(1,"IX")="^UTILITY(U,$J,"_DI_"^2",DPP=1

 S FLDS=DR,DHD=$G(DHD) S:$E(FLDS)'="[" FLDS="["_FLDS_"]"

 I FLDS'="[CAPTIONED]" K DA G N^DIP1

CAP ;Captioned output

 K DUOUT D ^%ZIS Q:POP  U IO

 S DIK=0 F  S DIK=$O(^UTILITY(U,$J,DIK)) Q:'DIK  S DA=$O(^(DIK,0)),E="N<1",N=-1,DD=+DPP(1) D GUY^DIQ Q:$G(DUOUT)  W !!

 D:'$G(DIPNCLOS) ^%ZISC K DR,DUOUT,DIPNCLOS Q

 ;

PRESORT ;Entry point for pre-sorted print

 ;DIC = file # or reference

 ;DA(n)=entry#  [n=1,2,3,...] entry #s to print

 ;DR  = template name

 N %,I,L,C,Q,DK,DPP,DI,Y,V,V1,DX,DIK

 ;Build sort array

 S V=$S($D(DA)#2:DA,1:"DA"),V1=$S(V["(":$E(V,1,$L(V)-1)_",",1:V_"(")

 S %=0 K ^UTILITY(U,$J) F  S V=$Q(@V) Q:$E(V,1,$L(V1))'=V1  S %=%+1,^UTILITY(U,$J,%,@V)=""

 G P1

INHDWPR   ;JSH; 8 Apr 94 17:02;Print Utilities 

 +1       ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001

 +2       ;COPYRIGHT 1991-2000 SAIC

 +3       ;

PRTLIST   ;Print specified entries from a file using a template

 +1       ;DIC = file # or reference

 +2       ;DA(n)=""  = entry #s to print

 +3       ;DR  = template name

 +4        NEW %,I,L,C,Q,DK,DPP,DI,Y,DX,DIK

 +5       ;Build sort array

 +6        SET %=0

           KILL ^UTILITY(U,$JOB)

           FOR I=0:0

               SET I=$ORDER(DA(I))

               IF 'I

                   QUIT 

               SET %=%+1

               SET ^UTILITY(U,$JOB,%,I)=""

P1         IF +DIC

               IF '$DATA(^DIC(DIC,0,"GL"))

                   QUIT 

               SET DIC=^DIC(DIC,0,"GL")

 +1        IF @("'$D("_DIC_"0))")

               QUIT 

 +2        SET Y=$PIECE(^(0),U,2)

           SET DI=DIC

           SET DPP(1)=+Y_"^^^@"

           SET DK=+Y

           SET Q=""""

           SET C=","

           SET L=0

 +3        SET DPP(1,"IX")="^UTILITY(U,$J,"_DI_"^2"

           SET DPP=1

 +4        SET FLDS=DR

           SET DHD=$GET(DHD)

           IF $EXTRACT(FLDS)'="["

               SET FLDS="["_FLDS_"]"

 +5        IF FLDS'="[CAPTIONED]"

               KILL DA

               GOTO N^DIP1

CAP       ;Captioned output

 +1        KILL DUOUT

           DO ^%ZIS

           IF POP

               QUIT 

           USE IO

 +2        SET DIK=0

           FOR 

               SET DIK=$ORDER(^UTILITY(U,$JOB,DIK))

               IF 'DIK

                   QUIT 

               SET DA=$ORDER(^(DIK,0))

               SET E="N<1"

               SET N=-1

               SET DD=+DPP(1)

               DO GUY^DIQ

               IF $GET(DUOUT)

                   QUIT 

               WRITE !!

 +3        IF '$GET(DIPNCLOS)

               DO ^%ZISC

           KILL DR,DUOUT,DIPNCLOS

           QUIT 

 +4       ;

PRESORT   ;Entry point for pre-sorted print

 +1       ;DIC = file # or reference

 +2       ;DA(n)=entry#  [n=1,2,3,...] entry #s to print

 +3       ;DR  = template name

 +4        NEW %,I,L,C,Q,DK,DPP,DI,Y,V,V1,DX,DIK

 +5       ;Build sort array

 +6        SET V=$SELECT($DATA(DA)#2:DA,1:"DA")

           SET V1=$SELECT(V["(":$EXTRACT(V,1,$LENGTH(V)-1)_",",1:V_"(")

 +7        SET %=0

           KILL ^UTILITY(U,$JOB)

           FOR 

               SET V=$QUERY(@V)

               IF $EXTRACT(V,1,$LENGTH(V1))'=V1

                   QUIT 

               SET %=%+1

               SET ^UTILITY(U,$JOB,%,@V)=""

 +8        GOTO P1