BDMPPDT ; IHS/TUCSON/TMJ - PRINT CONTROL CASE SUMMARY ; 28 Oct 2015 2:05 PM
;;2.0;DIABETES MANAGEMENT SYSTEM;**9**;JUN 14, 2007;Build 78
;IHS/CMI/LAB - added browsing to individual case summary
START D EN
EXIT D ^%ZISC
K ACM2,ACMS,ACMX,ACMA,ACMB,^UTILITY("DIQ1",$J),ACMDIC,DIC,DR,DA,ACMRAGE,ACMMHS,DC
Q
EN I $P(^ACM(41.1,ACMRG,0),U,10)=1 D
.S DIR(0)="YO",DIR("A")="Include PCC HEALTH SUMMARY",DIR("B")="NO"
.W !
.D ^DIR K DIR
.I Y=1 S ACMMHS="" D SELTYP^ACMPPDTX
BRPR ;
S DIR(0)="S^P:PRINT Output;B:BROWSE Output on Screen",DIR("A")="Do you wish to ",DIR("B")="P" K DA D ^DIR K DIR
I $D(DIRUT) G DONE
G:Y="B" BROWSE
K IOP
S %ZIS="PMQ"
W !
D ^%ZIS
G:POP DONE
I IO=IO(0),$D(IO("Q")) W !,"Cannot Queue to Screen or Slave Printer!",! K IO("Q") G EN
I $D(IO("Q")) S ZTRTN="DQ^BDMPPDT",ZTSAVE("ACM*")="",ZTDESC="CMS DATA SHEET PRINT" D ^%ZTLOAD W !,"REQUEST QUEUED!" K IO("Q"),ZTSK G DONE
;I IOST["C-" S ^UTILITY($J,1)="R ""Strike <CR> to continue. "",X:DTIME W:$D(IOF) @IOF"
K DIR S DIR(0)="E",DIR("A")="Strike <ENTER> to continue." D ^DIR K DIR W:$D(IOF) @IOF
DQ ;EP - U IO
I '$G(BDMMULTS) U IO
Q:'$D(ACMRGDFN)
S D0=ACMRGDFN,ACMCTRL=ACMCTRLP,ACMCTRL="PAGE;"_ACMCTRL
S:ACMCTRL["APPL" ACMCTRL=$P(ACMCTRL,";APPL")_$P(ACMCTRL,";APPL",2)
S:ACMCTRL["CRL" ACMCTRL=$P(ACMCTRL,";CRL")_$P(ACMCTRL,";CRL",2)
S ACMCNT=$L(ACMCTRL,";")
F ACMJ=1:1:ACMCNT S ACMLINER=$P(ACMCTRL,";",ACMJ),DC="," K DXS D @ACMLINER
K ACMJ,ACMCNT
I IOST["C-",'$D(IO("Q")),IO=IO(0) D PAUSE
I $D(ACMZQUIT) G DONE
W:IOST["P-" @IOF
I $D(ACMMHS) D PCCHS^ACMPPDTX
DONE D ^%ZISC
K %ZIS,DXS,^UTILITY($J)
S ZTREQ="@"
S IOP=ION
D ^%ZIS
W @IOF
Q
BROWSE ;
;
I $T(VIEWR^XBLM)="" W !!!?5,"*** Browser Utility not available!! ***" Q
D VIEWR^XBLM("DQ^BDMPPDT")
G DONE
;
PAGE D ^ACMRAGE Q
REG D ^ACMLCMS,ACMPT^ACMLCMS Q
PROB D ^ACMPROB Q
CH D ^ACMRCH Q
DC D:$D(^ACM(51,"AC",ACMRG,ACMPTNO)) ^ACMRDC Q
DX D:$D(^ACM(44,"AC",ACMRG,ACMPTNO)) ^ACMRDX Q
ET D:$D(^ACM(53,"AC",ACMRG,ACMPTNO)) ^ACMRET Q
CMP D:$D(^ACM(42,"AC",ACMRG,ACMPTNO)) ^ACMRCMP Q
CP D:$D(^ACM(48,"AC",ACMRG,ACMPTNO)) ^ACMRCP Q
AP D:$D(^ACM(43,"AC",ACMRG,ACMPTNO)) ^ACMRAP Q
RF D:$D(^ACM(45,"AC",ACMRG,ACMPTNO)) ^ACMROF Q
FM D:$D(^ACM(46,"AC",ACMRG,ACMPTNO)) ^ACMRFM Q
MEAS D:$D(^ACM(57,"AC",ACMRG,ACMPTNO)) ^ACMRMS Q
MD D:$D(^ACM(54,"AC",ACMRG,ACMPTNO)) ^ACMRMD Q
SV D:$D(^ACM(47,"AC",ACMRG,ACMPTNO)) ^ACMRSV Q
APPT D:$D(^ACM(49,"AC",ACMRG,ACMPTNO)) ^ACMRAPP Q
CR D:($P(^ACM(41,ACMRGDFN,"DT"),U,8)'="")!($P(^("DT"),U,9)'="") ^ACMRNT Q
CT D:$D(^ACM(41,ACMRGDFN,1)) ^ACMRCMT Q
PAUSE W !!,"End of report for ",ACMPTNA2
S DIR(0)="EOA",DIR("A")="Press <ENTER> to continue..... "
D ^DIR K DIR
I $D(DIRUT) S ACMZQUIT=1
Q
BDMPPDT ; IHS/TUCSON/TMJ - PRINT CONTROL CASE SUMMARY ; 28 Oct 2015 2:05 PM
+1 ;;2.0;DIABETES MANAGEMENT SYSTEM;**9**;JUN 14, 2007;Build 78
+2 ;IHS/CMI/LAB - added browsing to individual case summary
START DO EN
EXIT DO ^%ZISC
+1 KILL ACM2,ACMS,ACMX,ACMA,ACMB,^UTILITY("DIQ1",$JOB),ACMDIC,DIC,DR,DA,ACMRAGE,ACMMHS,DC
+2 QUIT
EN IF $PIECE(^ACM(41.1,ACMRG,0),U,10)=1
Begin DoDot:1
+1 SET DIR(0)="YO"
SET DIR("A")="Include PCC HEALTH SUMMARY"
SET DIR("B")="NO"
+2 WRITE !
+3 DO ^DIR
KILL DIR
+4 IF Y=1
SET ACMMHS=""
DO SELTYP^ACMPPDTX
End DoDot:1
BRPR ;
+1 SET DIR(0)="S^P:PRINT Output;B:BROWSE Output on Screen"
SET DIR("A")="Do you wish to "
SET DIR("B")="P"
KILL DA
DO ^DIR
KILL DIR
+2 IF $DATA(DIRUT)
GOTO DONE
+3 IF Y="B"
GOTO BROWSE
+4 KILL IOP
+5 SET %ZIS="PMQ"
+6 WRITE !
+7 DO ^%ZIS
+8 IF POP
GOTO DONE
+9 IF IO=IO(0)
IF $DATA(IO("Q"))
WRITE !,"Cannot Queue to Screen or Slave Printer!",!
KILL IO("Q")
GOTO EN
+10 IF $DATA(IO("Q"))
SET ZTRTN="DQ^BDMPPDT"
SET ZTSAVE("ACM*")=""
SET ZTDESC="CMS DATA SHEET PRINT"
DO ^%ZTLOAD
WRITE !,"REQUEST QUEUED!"
KILL IO("Q"),ZTSK
GOTO DONE
+11 ;I IOST["C-" S ^UTILITY($J,1)="R ""Strike <CR> to continue. "",X:DTIME W:$D(IOF) @IOF"
+12 KILL DIR
SET DIR(0)="E"
SET DIR("A")="Strike <ENTER> to continue."
DO ^DIR
KILL DIR
IF $DATA(IOF)
WRITE @IOF
DQ ;EP - U IO
+1 IF '$GET(BDMMULTS)
USE IO
+2 IF '$DATA(ACMRGDFN)
QUIT
+3 SET D0=ACMRGDFN
SET ACMCTRL=ACMCTRLP
SET ACMCTRL="PAGE;"_ACMCTRL
+4 IF ACMCTRL["APPL"
SET ACMCTRL=$PIECE(ACMCTRL,";APPL")_$PIECE(ACMCTRL,";APPL",2)
+5 IF ACMCTRL["CRL"
SET ACMCTRL=$PIECE(ACMCTRL,";CRL")_$PIECE(ACMCTRL,";CRL",2)
+6 SET ACMCNT=$LENGTH(ACMCTRL,";")
+7 FOR ACMJ=1:1:ACMCNT
SET ACMLINER=$PIECE(ACMCTRL,";",ACMJ)
SET DC=","
KILL DXS
DO @ACMLINER
+8 KILL ACMJ,ACMCNT
+9 IF IOST["C-"
IF '$DATA(IO("Q"))
IF IO=IO(0)
DO PAUSE
+10 IF $DATA(ACMZQUIT)
GOTO DONE
+11 IF IOST["P-"
WRITE @IOF
+12 IF $DATA(ACMMHS)
DO PCCHS^ACMPPDTX
DONE DO ^%ZISC
+1 KILL %ZIS,DXS,^UTILITY($JOB)
+2 SET ZTREQ="@"
+3 SET IOP=ION
+4 DO ^%ZIS
+5 WRITE @IOF
+6 QUIT
BROWSE ;
+1 ;
+2 IF $TEXT(VIEWR^XBLM)=""
WRITE !!!?5,"*** Browser Utility not available!! ***"
QUIT
+3 DO VIEWR^XBLM("DQ^BDMPPDT")
+4 GOTO DONE
+5 ;
PAGE DO ^ACMRAGE
QUIT
REG DO ^ACMLCMS
DO ACMPT^ACMLCMS
QUIT
PROB DO ^ACMPROB
QUIT
CH DO ^ACMRCH
QUIT
DC IF $DATA(^ACM(51,"AC",ACMRG,ACMPTNO))
DO ^ACMRDC
QUIT
DX IF $DATA(^ACM(44,"AC",ACMRG,ACMPTNO))
DO ^ACMRDX
QUIT
ET IF $DATA(^ACM(53,"AC",ACMRG,ACMPTNO))
DO ^ACMRET
QUIT
CMP IF $DATA(^ACM(42,"AC",ACMRG,ACMPTNO))
DO ^ACMRCMP
QUIT
CP IF $DATA(^ACM(48,"AC",ACMRG,ACMPTNO))
DO ^ACMRCP
QUIT
AP IF $DATA(^ACM(43,"AC",ACMRG,ACMPTNO))
DO ^ACMRAP
QUIT
RF IF $DATA(^ACM(45,"AC",ACMRG,ACMPTNO))
DO ^ACMROF
QUIT
FM IF $DATA(^ACM(46,"AC",ACMRG,ACMPTNO))
DO ^ACMRFM
QUIT
MEAS IF $DATA(^ACM(57,"AC",ACMRG,ACMPTNO))
DO ^ACMRMS
QUIT
MD IF $DATA(^ACM(54,"AC",ACMRG,ACMPTNO))
DO ^ACMRMD
QUIT
SV IF $DATA(^ACM(47,"AC",ACMRG,ACMPTNO))
DO ^ACMRSV
QUIT
APPT IF $DATA(^ACM(49,"AC",ACMRG,ACMPTNO))
DO ^ACMRAPP
QUIT
CR IF ($PIECE(^ACM(41,ACMRGDFN,"DT"),U,8)'="")!($PIECE(^("DT"),U,9)'="")
DO ^ACMRNT
QUIT
CT IF $DATA(^ACM(41,ACMRGDFN,1))
DO ^ACMRCMT
QUIT
PAUSE WRITE !!,"End of report for ",ACMPTNA2
+1 SET DIR(0)="EOA"
SET DIR("A")="Press <ENTER> to continue..... "
+2 DO ^DIR
KILL DIR
+3 IF $DATA(DIRUT)
SET ACMZQUIT=1
+4 QUIT
