- 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 Jan 18, 2025@03:45:49 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