DGMTP ;ALB/RMO,CAW,EG - Print Means Test 10-10F ; 03/07/2005
;;5.3;Registration;**45,300,610**;Aug 13, 1993
;
EN ;Entry point to select a means test to print
S DIC="^DPT(",DIC(0)="AEMQ" W ! D ^DIC K DIC G Q:Y<0 S DFN=+Y
;
DT S DIC("A")="Select DATE OF TEST: "
I $D(^DGMT(408.31,+$$LST^DGMTU(DFN,"",DGMTYPT),0)),"^1^3^"'[("^"_$P(^(0),"^",3)_"^") S DIC("B")=$P(^(0),"^")
S DIC("S")="I $P(^(0),U,2)=DFN,""^1^3^""'[(U_$P(^(0),U,3)_U)"
S DIC="^DGMT(408.31,",DIC(0)="EQ" W ! D EN^DGMTLK K DIC G Q:Y<0
S DGMTI=+Y,DGMTDT=$P(Y,"^",2)
;
DEV ;Ask device
S DGPGM="START^DGMTP",DGVAR="DFN^DGMTI^DGMTDT^DGMTYPT"
;
;added code to not allow a slave printer to be selected
;eg 03/07/2005
W !!,*7,"THIS OUTPUT REQUIRES 132 COLUMN OUTPUT TO THE PRINTER."
W !,"DO NOT SELECT A SLAVE DEVICE FOR QUEUED OUTPUT.",!
S %ZIS="QM",%ZIS("S")="I $P($G(^(1)),U)'[""SLAVE""&($P($G(^(0)),U)'[""SLAVE"")",%ZIS("B")="",IOP="Q"
D ZIS^DGUTQ
I POP D G Q
. I $D(IO("Q")) K IO("Q")
. U 0 W !,"Print request cancelled!"
. Q
I IO=IO(0),$E(IOST,1,2)="C-" W !,*7,"CANNOT QUEUE TO HOME DEVICE!",! G DEV
Q
;
START ;Entry point to print a means test
; Input -- DFN Patient IEN
; DGMTDT Date of Test
; DGMTI Annual Means Test IEN
; DGOPT Registration Flag
; DGMTYPT Type of Test 1=MT 2=COPAY
; Output -- Print of 10-10F
U IO
S DGUL=$S('($D(IOST)#2):"-",IOST["C-":"-",1:"_"),(DGLNE,DGLNE1)="",$P(DGLNE,"=",131)="",$P(DGLNE1,DGUL,131)=""
D ALL^DGMTU21(DFN,"V",DGMTDT,"IPR",$S($G(DGMTI):DGMTI,1:""))
G Q:'$D(DGINC("V"))!('$D(DGINR("V")))!('$D(DGREL("V")))
S DGVPRI=+DGREL("V"),DGVINI=DGINC("V"),DGVIRI=DGINR("V")
S DGLY=$$LYR^DGMTSCU1(DGMTDT) D PAR^DGMTSCU G Q:DGMTPAR=""
D SET^DGMTSCU2,SET^DGMTSC31
S DGMT0=$G(^DGMT(408.31,DGMTI,0))
D EN^DGMTP1
;
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
K DTOUT,DUOUT,POP,X,Y
I '$D(DGOPT) K DFN,DGMTDT,DGMTI W ! D CLOSE^DGUTQ
Q
;
HD ;Print header
W @IOF,!,$$NAME^DGMTU1(DGVPRI),?116,$$SSN^DGMTU1(DGVPRI),!,DGLNE
Q
;
FT ;Print footer
N Y,%
W !,DGLNE S Y=+DGMT0 X ^DD("DD") W !,"Date of Test: ",Y
S Y=$P(DGMT0,"^",7) X ^DD("DD") W ?31,"Completion Date/time: ",Y
;
; retrieve who completed the means test and print initials
N X,INI S X=$P(DGMT0,U,6),INI=""
I X'="" S INI=$$GET1^DIQ(200,X,1)
I INI'="" S INI=INI_"/"_X
W ?75,"By: ",INI
;
D NOW^%DTC S Y=% X ^DD("DD") W ?98,"Printed: ",Y
W !!!!,"VA FORM 10-10F",?120,"PAGE ",DGPGE
W:DGPGE=2 @IOF
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGMTP 2688 printed Oct 16, 2024@18:45:46 Page 2
DGMTP ;ALB/RMO,CAW,EG - Print Means Test 10-10F ; 03/07/2005
+1 ;;5.3;Registration;**45,300,610**;Aug 13, 1993
+2 ;
EN ;Entry point to select a means test to print
+1 SET DIC="^DPT("
SET DIC(0)="AEMQ"
WRITE !
DO ^DIC
KILL DIC
if Y<0
GOTO Q
SET DFN=+Y
+2 ;
DT SET DIC("A")="Select DATE OF TEST: "
+1 IF $DATA(^DGMT(408.31,+$$LST^DGMTU(DFN,"",DGMTYPT),0))
IF "^1^3^"'[("^"_$PIECE(^(0),"^",3)_"^")
SET DIC("B")=$PIECE(^(0),"^")
+2 SET DIC("S")="I $P(^(0),U,2)=DFN,""^1^3^""'[(U_$P(^(0),U,3)_U)"
+3 SET DIC="^DGMT(408.31,"
SET DIC(0)="EQ"
WRITE !
DO EN^DGMTLK
KILL DIC
if Y<0
GOTO Q
+4 SET DGMTI=+Y
SET DGMTDT=$PIECE(Y,"^",2)
+5 ;
DEV ;Ask device
+1 SET DGPGM="START^DGMTP"
SET DGVAR="DFN^DGMTI^DGMTDT^DGMTYPT"
+2 ;
+3 ;added code to not allow a slave printer to be selected
+4 ;eg 03/07/2005
+5 WRITE !!,*7,"THIS OUTPUT REQUIRES 132 COLUMN OUTPUT TO THE PRINTER."
+6 WRITE !,"DO NOT SELECT A SLAVE DEVICE FOR QUEUED OUTPUT.",!
+7 SET %ZIS="QM"
SET %ZIS("S")="I $P($G(^(1)),U)'[""SLAVE""&($P($G(^(0)),U)'[""SLAVE"")"
SET %ZIS("B")=""
SET IOP="Q"
+8 DO ZIS^DGUTQ
+9 IF POP
Begin DoDot:1
+10 IF $DATA(IO("Q"))
KILL IO("Q")
+11 USE 0
WRITE !,"Print request cancelled!"
+12 QUIT
End DoDot:1
GOTO Q
+13 IF IO=IO(0)
IF $EXTRACT(IOST,1,2)="C-"
WRITE !,*7,"CANNOT QUEUE TO HOME DEVICE!",!
GOTO DEV
+14 QUIT
+15 ;
START ;Entry point to print a means test
+1 ; Input -- DFN Patient IEN
+2 ; DGMTDT Date of Test
+3 ; DGMTI Annual Means Test IEN
+4 ; DGOPT Registration Flag
+5 ; DGMTYPT Type of Test 1=MT 2=COPAY
+6 ; Output -- Print of 10-10F
+7 USE IO
+8 SET DGUL=$SELECT('($DATA(IOST)#2):"-",IOST["C-":"-",1:"_")
SET (DGLNE,DGLNE1)=""
SET $PIECE(DGLNE,"=",131)=""
SET $PIECE(DGLNE1,DGUL,131)=""
+9 DO ALL^DGMTU21(DFN,"V",DGMTDT,"IPR",$SELECT($GET(DGMTI):DGMTI,1:""))
+10 if '$DATA(DGINC("V"))!('$DATA(DGINR("V")))!('$DATA(DGREL("V")))
GOTO Q
+11 SET DGVPRI=+DGREL("V")
SET DGVINI=DGINC("V")
SET DGVIRI=DGINR("V")
+12 SET DGLY=$$LYR^DGMTSCU1(DGMTDT)
DO PAR^DGMTSCU
if DGMTPAR=""
GOTO Q
+13 DO SET^DGMTSCU2
DO SET^DGMTSC31
+14 SET DGMT0=$GET(^DGMT(408.31,DGMTI,0))
+15 DO EN^DGMTP1
+16 ;
Q KILL 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
+1 KILL DTOUT,DUOUT,POP,X,Y
+2 IF '$DATA(DGOPT)
KILL DFN,DGMTDT,DGMTI
WRITE !
DO CLOSE^DGUTQ
+3 QUIT
+4 ;
HD ;Print header
+1 WRITE @IOF,!,$$NAME^DGMTU1(DGVPRI),?116,$$SSN^DGMTU1(DGVPRI),!,DGLNE
+2 QUIT
+3 ;
FT ;Print footer
+1 NEW Y,%
+2 WRITE !,DGLNE
SET Y=+DGMT0
XECUTE ^DD("DD")
WRITE !,"Date of Test: ",Y
+3 SET Y=$PIECE(DGMT0,"^",7)
XECUTE ^DD("DD")
WRITE ?31,"Completion Date/time: ",Y
+4 ;
+5 ; retrieve who completed the means test and print initials
+6 NEW X,INI
SET X=$PIECE(DGMT0,U,6)
SET INI=""
+7 IF X'=""
SET INI=$$GET1^DIQ(200,X,1)
+8 IF INI'=""
SET INI=INI_"/"_X
+9 WRITE ?75,"By: ",INI
+10 ;
+11 DO NOW^%DTC
SET Y=%
XECUTE ^DD("DD")
WRITE ?98,"Printed: ",Y
+12 WRITE !!!!,"VA FORM 10-10F",?120,"PAGE ",DGPGE
+13 if DGPGE=2
WRITE @IOF
+14 QUIT
