Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DGMTP

DGMTP.m

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