source: FOIAVistA/trunk/r/AUTOMATED_MED_INFO_EXCHANGE-DVBA-DVBC/DVBACPPB.m@ 1607

Last change on this file since 1607 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 1.2 KB
Line 
1DVBACPPB ;ALB/DW - Print Blank C&P Worksheets ; 8/27/1999
2 ;;2.7;AMIE;**30**;Apr 10, 1995
3 ;
4 ;
5EN ;Entry point of the routine.
6 N X,Y,CPNO,HD7,HD8,HD9,HD91,LX,LY,PG,DTOUT
7 D HOME^%ZIS
8 D SELECT
9 I X="^"!(X="") W @IOF Q
10 I $D(DTOUT) W *7 W @IOF Q
11 S CPNO=+Y
12 D PRINT
13 D EXIT
14 W @IOF
15 Q
16 ;
17SELECT ;Select C&P worksheet to print.
18 N DIC
19 S DIC="^DVB(396.6,",DIC(0)="AEQM",DIC("A")="Select C&P worksheet to print: "
20 S DIC("S")="I $P($G(^DVB(396.6,Y,0)),U,5)=""A"""
21 D ^DIC
22 Q
23 ;
24PRINT ;Select device to print the chosen C&P worksheet.
25 W !!,"** Worksheets should be sent to a printer. **",!!
26 N CODE,NAME,SSN,CNUM
27 N POP,ZTSAVE,TSK,%ZIS,ZTRTN,ZTDESC,ZTSK
28 S %ZIS="QM" D ^%ZIS Q:POP
29 I $D(IO("Q")) D Q
30 . S ZTRTN="WRITER^DVBACPPB",ZTDESC="DVBA Print blank C&P worksheets."
31 . S ZTSAVE("CPNO")=""
32 . D ^%ZTLOAD
33 . S TSK=$S($D(ZTSK)=0:"C",1:"Y")
34 . I TSK="Y" W !!,"Task queued! Task number: ",ZTSK
35 . D HOME^%ZIS
36 I '$D(IO("Q")) D WRITER
37 Q
38 ;
39WRITER ;Print out the chosen worksheet.
40 U IO
41 I $E(IOST,1,2)="C-" W @IOF
42 S CODE=$P($G(^DVB(396.6,CPNO,0)),U,4) I $G(CODE)="" Q
43 S (NAME,SSN,CNUM)=""
44 S CODE="^"_CODE
45 D @CODE
46 D ^%ZISC
47 Q
48 ;
49EXIT ;Clean up variables upon exit.
50 S:$D(ZTQUEUED) ZTREQ="@"
51 Q
52 ;
Note: See TracBrowser for help on using the repository browser.