source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGMTP.m@ 1259

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

initial load of WorldVistAEHR

File size: 2.6 KB
Line 
1DGMTP ;ALB/RMO,CAW,EG - Print Means Test 10-10F ; 03/07/2005
2 ;;5.3;Registration;**45,300,610**;Aug 13, 1993
3 ;
4EN ;Entry point to select a means test to print
5 S DIC="^DPT(",DIC(0)="AEMQ" W ! D ^DIC K DIC G Q:Y<0 S DFN=+Y
6 ;
7DT S DIC("A")="Select DATE OF TEST: "
8 I $D(^DGMT(408.31,+$$LST^DGMTU(DFN,"",DGMTYPT),0)),"^1^3^"'[("^"_$P(^(0),"^",3)_"^") S DIC("B")=$P(^(0),"^")
9 S DIC("S")="I $P(^(0),U,2)=DFN,""^1^3^""'[(U_$P(^(0),U,3)_U)"
10 S DIC="^DGMT(408.31,",DIC(0)="EQ" W ! D EN^DGMTLK K DIC G Q:Y<0
11 S DGMTI=+Y,DGMTDT=$P(Y,"^",2)
12 ;
13DEV ;Ask device
14 S DGPGM="START^DGMTP",DGVAR="DFN^DGMTI^DGMTDT^DGMTYPT"
15 ;
16 ;added code to not allow a slave printer to be selected
17 ;eg 03/07/2005
18 W !!,*7,"THIS OUTPUT REQUIRES 132 COLUMN OUTPUT TO THE PRINTER."
19 W !,"DO NOT SELECT A SLAVE DEVICE FOR QUEUED OUTPUT.",!
20 S %ZIS="QM",%ZIS("S")="I $P($G(^(1)),U)'[""SLAVE""&($P($G(^(0)),U)'[""SLAVE"")",%ZIS("B")="",IOP="Q"
21 D ZIS^DGUTQ
22 I POP D G Q
23 . I $D(IO("Q")) K IO("Q")
24 . U 0 W !,"Print request cancelled!"
25 . Q
26 I IO=IO(0),$E(IOST,1,2)="C-" W !,*7,"CANNOT QUEUE TO HOME DEVICE!",! G DEV
27 Q
28 ;
29START ;Entry point to print a means test
30 ; Input -- DFN Patient IEN
31 ; DGMTDT Date of Test
32 ; DGMTI Annual Means Test IEN
33 ; DGOPT Registration Flag
34 ; DGMTYPT Type of Test 1=MT 2=COPAY
35 ; Output -- Print of 10-10F
36 U IO
37 S DGUL=$S('($D(IOST)#2):"-",IOST["C-":"-",1:"_"),(DGLNE,DGLNE1)="",$P(DGLNE,"=",131)="",$P(DGLNE1,DGUL,131)=""
38 D ALL^DGMTU21(DFN,"V",DGMTDT,"IPR",$S($G(DGMTI):DGMTI,1:""))
39 G Q:'$D(DGINC("V"))!('$D(DGINR("V")))!('$D(DGREL("V")))
40 S DGVPRI=+DGREL("V"),DGVINI=DGINC("V"),DGVIRI=DGINR("V")
41 S DGLY=$$LYR^DGMTSCU1(DGMTDT) D PAR^DGMTSCU G Q:DGMTPAR=""
42 D SET^DGMTSCU2,SET^DGMTSC31
43 S DGMT0=$G(^DGMT(408.31,DGMTI,0))
44 D EN^DGMTP1
45 ;
46Q K DGCAT,DGDC,DGDCS,DGDEP,DGDET,DGFL,DGIN0,DGIN1,DGIN2,DGINC,DGINR,DGINT,DGINTF,DGLNE,DGLNE1,DGLP,DGLY,DGMT0,DGMTPAR,DGMTS,DGNC,DGND,DGNWT,DGNWTF,DGPGE,DGPGM,DGREL,DGSP,DGTYC,DGTHA,DGTHB,DGUL,DGVINI,DGVIRI,DGVIR0,DGVPRI
47 K DTOUT,DUOUT,POP,X,Y
48 I '$D(DGOPT) K DFN,DGMTDT,DGMTI W ! D CLOSE^DGUTQ
49 Q
50 ;
51HD ;Print header
52 W @IOF,!,$$NAME^DGMTU1(DGVPRI),?116,$$SSN^DGMTU1(DGVPRI),!,DGLNE
53 Q
54 ;
55FT ;Print footer
56 N Y,%
57 W !,DGLNE S Y=+DGMT0 X ^DD("DD") W !,"Date of Test: ",Y
58 S Y=$P(DGMT0,"^",7) X ^DD("DD") W ?31,"Completion Date/time: ",Y
59 ;
60 ; retrieve who completed the means test and print initials
61 N X,INI S X=$P(DGMT0,U,6),INI=""
62 I X'="" S INI=$$GET1^DIQ(200,X,1)
63 I INI'="" S INI=INI_"/"_X
64 W ?75,"By: ",INI
65 ;
66 D NOW^%DTC S Y=% X ^DD("DD") W ?98,"Printed: ",Y
67 W !!!!,"VA FORM 10-10F",?120,"PAGE ",DGPGE
68 W:DGPGE=2 @IOF
69 Q
Note: See TracBrowser for help on using the repository browser.