PRCALET.m

PRCALET ;WASH-ISC@ALTOONA,PA/CMS-PRINT FORM LETTERS ;6/4/93  8:43 AM

V ;;4.5;Accounts Receivable;**198**;Mar 20, 1995

 ;;Per VHA Directive 10-93-142, this routine should not be modified.

 NEW DIC,IOP,SITE,PRCABN,PRCALT,POP,X,Y,ZTDESC,ZTRTN,ZTSAVE,ZTSK,%ZIS

 S DIC="^RC(343,",DIC("A")="ENTER THE FORM LETTER TO TEST: ",DIC(0)="AEQM" D ^DIC K DIC G:Y<0 Q S PRCALT=+Y

 N DPTNOFZY,DPTNOFZK S (DPTNOFZY,DPTNOFZK)=1

 S DIC="^PRCA(430,",DIC(0)="AEQM" D ^DIC K DIC G:Y<0 Q S PRCABN=+Y

ST W ! S IOP="Q",%ZIS="NQ" S %ZIS("B")="" D ^%ZIS G:POP Q

 I '$D(IO("Q")) W !!,"YOU MUST QUEUE THE OUTPUT" G ST

 S ZTRTN="QUE^PRCALET",ZTDESC="Print Form Letter",ZTSAVE("PRCALT")="",ZTSAVE("PRCABN")="" D ^%ZTLOAD

Q D ^%ZISC Q

QUE D PRT^PRCAGF(PRCALT,PRCABN)

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PRCALET   751     printed  Apr 09, 2024@20:44:27                                                                                                                                                                                                      Page 2

PRCALET   ;WASH-ISC@ALTOONA,PA/CMS-PRINT FORM LETTERS ;6/4/93  8:43 AM

V         ;;4.5;Accounts Receivable;**198**;Mar 20, 1995

 +1       ;;Per VHA Directive 10-93-142, this routine should not be modified.

 +2        NEW DIC,IOP,SITE,PRCABN,PRCALT,POP,X,Y,ZTDESC,ZTRTN,ZTSAVE,ZTSK,%ZIS

 +3        SET DIC="^RC(343,"

           SET DIC("A")="ENTER THE FORM LETTER TO TEST: "

           SET DIC(0)="AEQM"

           DO ^DIC

           KILL DIC

           if Y<0

               GOTO Q

           SET PRCALT=+Y

 +4        NEW DPTNOFZY,DPTNOFZK

           SET (DPTNOFZY,DPTNOFZK)=1

 +5        SET DIC="^PRCA(430,"

           SET DIC(0)="AEQM"

           DO ^DIC

           KILL DIC

           if Y<0

               GOTO Q

           SET PRCABN=+Y

ST         WRITE !

           SET IOP="Q"

           SET %ZIS="NQ"

           SET %ZIS("B")=""

           DO ^%ZIS

           if POP

               GOTO Q

 +1        IF '$DATA(IO("Q"))

               WRITE !!,"YOU MUST QUEUE THE OUTPUT"

               GOTO ST

 +2        SET ZTRTN="QUE^PRCALET"

           SET ZTDESC="Print Form Letter"

           SET ZTSAVE("PRCALT")=""

           SET ZTSAVE("PRCABN")=""

           DO ^%ZTLOAD

Q          DO ^%ZISC

           QUIT 

QUE        DO PRT^PRCAGF(PRCALT,PRCABN)

 +1        QUIT