- ACMPPDT ; IHS/TUCSON/TMJ - PRINT CONTROL CASE SUMMARY ; [ 02/02/2009 7:32 AM ]
- ;;2.0;ACM CASE MANAGEMENT SYSTEM;**2,8**;JAN 10, 1996
- ;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^ACMPPDT",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
- 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
- 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^ACMPPDT")
- 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
- Q
- ACMPPDT ; IHS/TUCSON/TMJ - PRINT CONTROL CASE SUMMARY ; [ 02/02/2009 7:32 AM ]
- +1 ;;2.0;ACM CASE MANAGEMENT SYSTEM;**2,8**;JAN 10, 1996
- +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^ACMPPDT"
- 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 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 IOST["P-"
- WRITE @IOF
- +11 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^ACMPPDT")
- +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 QUIT
