| [613] | 1 | DGMTP ;ALB/RMO,CAW,EG - Print Means Test 10-10F ; 03/07/2005
|
|---|
| 2 | ;;5.3;Registration;**45,300,610**;Aug 13, 1993
|
|---|
| 3 | ;
|
|---|
| 4 | EN ;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 | ;
|
|---|
| 7 | DT 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 | ;
|
|---|
| 13 | DEV ;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 | ;
|
|---|
| 29 | START ;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 | ;
|
|---|
| 46 | Q 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 | ;
|
|---|
| 51 | HD ;Print header
|
|---|
| 52 | W @IOF,!,$$NAME^DGMTU1(DGVPRI),?116,$$SSN^DGMTU1(DGVPRI),!,DGLNE
|
|---|
| 53 | Q
|
|---|
| 54 | ;
|
|---|
| 55 | FT ;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
|
|---|
