ACMPPDTX ; IHS/TUCSON/TMJ - HEALTH SUMMARY DISPLAYS ; [ 11/02/05 1:10 PM ]
;;2.0;ACM CASE MANAGEMENT SYSTEM;*1,4,6,8*;JAN 10, 1996
;;Patch #1 - not quitting when printing multiple PCC Health Summaries
START Q:$G(ACMQUIT)=1 ;IHS/CMI/TMJ PATCH #6
D EN
I $D(ACMMHS) D PCCHS
Q ;IHS/OHPRD/TMJ Patch #1 added Quit
EXIT K ACM2,ACMS,ACMX,ACMA,ACMB,^UTILITY("DIQ1",$J),ACMDIC,ACMPAGE,ACMMHS
Q
EN ;
S ACMQUIT="" ;IHS/CMI/TMJ PATCH #6
DQ I $D(D0) S ACMRGDFN=D0,ACMRG=$P(^ACM(41,D0,0),U),ACMPTNO=$P(^(0),U,2),ACMPTNA=$P(^DPT(ACMPTNO,0),U)
S 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 $G(DIRUT)=1 S ACMQUIT=1 Q ;IHS/CMI/TMJ PATCH #6 11/2/05
W:IOST["P-" @IOF
DONE Q
CMGT Q
;
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
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
MEAS D:$D(^ACM(57,"AC",ACMRG,ACMPTNO)) ^ACMRMS 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 ",ACMPTNA
PAUSE1 ;EP;TO HANDLE SCREEN PAUSE
S ACMQUIT=""
S DIR(0)="EOA",DIR("A")="Press <ENTER> to continue..... "
D ^DIR K DIR S:$D(DUOUT) DIRUT=1
Q
;
PCCHS ;EP;FOR MULTIPLE PCC HEALTH SUMMARIES
Q:'$D(D0)!'$D(ACMSTYP)
;I $D(DIRUT) Q
S APCHSPAT=$P(^ACM(41,D0,0),U,2),APCHSTYP=ACMSTYP
D EN^APCHS
I $E(IOST,1,2)="C-" D PAUSE1
Q
SELTYP ;PEP;TO SELECT HEALTH SUMMARY TYPE
K DIC
S DIC="^APCHSCTL(",DIC("A")="Select health summary type: ",DIC(0)="AEQM",DIC("B")="ADULT REGULAR"
W !
D ^DIC
K DIC,DA,DR
I Y<0 G EXIT:U[X,SELTYP
S ACMSTYP=+Y
Q
ACMPPDTX ; IHS/TUCSON/TMJ - HEALTH SUMMARY DISPLAYS ; [ 11/02/05 1:10 PM ]
+1 ;;2.0;ACM CASE MANAGEMENT SYSTEM;*1,4,6,8*;JAN 10, 1996
+2 ;;Patch #1 - not quitting when printing multiple PCC Health Summaries
START ;IHS/CMI/TMJ PATCH #6
IF $GET(ACMQUIT)=1
QUIT
+1 DO EN
+2 IF $DATA(ACMMHS)
DO PCCHS
+3 ;IHS/OHPRD/TMJ Patch #1 added Quit
QUIT
EXIT KILL ACM2,ACMS,ACMX,ACMA,ACMB,^UTILITY("DIQ1",$JOB),ACMDIC,ACMPAGE,ACMMHS
+1 QUIT
EN ;
+1 ;IHS/CMI/TMJ PATCH #6
SET ACMQUIT=""
DQ IF $DATA(D0)
SET ACMRGDFN=D0
SET ACMRG=$PIECE(^ACM(41,D0,0),U)
SET ACMPTNO=$PIECE(^(0),U,2)
SET ACMPTNA=$PIECE(^DPT(ACMPTNO,0),U)
+1 SET ACMCTRL=ACMCTRLP
SET ACMCTRL="PAGE;"_ACMCTRL
+2 IF ACMCTRL["APPL"
SET ACMCTRL=$PIECE(ACMCTRL,";APPL")_$PIECE(ACMCTRL,";APPL",2)
+3 IF ACMCTRL["CRL"
SET ACMCTRL=$PIECE(ACMCTRL,";CRL")_$PIECE(ACMCTRL,";CRL",2)
+4 SET ACMCNT=$LENGTH(ACMCTRL,";")
+5 FOR ACMJ=1:1:ACMCNT
SET ACMLINER=$PIECE(ACMCTRL,";",ACMJ)
SET DC=","
KILL DXS
DO @ACMLINER
+6 KILL ACMJ,ACMCNT
+7 IF IOST["C-"
IF ('$DATA(IO("Q"))!(IO=IO(0)))
DO PAUSE
+8 ;IHS/CMI/TMJ PATCH #6 11/2/05
IF $GET(DIRUT)=1
SET ACMQUIT=1
QUIT
+9 IF IOST["P-"
WRITE @IOF
DONE QUIT
CMGT QUIT
+1 ;
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
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
MEAS IF $DATA(^ACM(57,"AC",ACMRG,ACMPTNO))
DO ^ACMRMS
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 ",ACMPTNA
PAUSE1 ;EP;TO HANDLE SCREEN PAUSE
+1 SET ACMQUIT=""
+2 SET DIR(0)="EOA"
SET DIR("A")="Press <ENTER> to continue..... "
+3 DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+4 QUIT
+5 ;
PCCHS ;EP;FOR MULTIPLE PCC HEALTH SUMMARIES
+1 IF '$DATA(D0)!'$DATA(ACMSTYP)
QUIT
+2 ;I $D(DIRUT) Q
+3 SET APCHSPAT=$PIECE(^ACM(41,D0,0),U,2)
SET APCHSTYP=ACMSTYP
+4 DO EN^APCHS
+5 IF $EXTRACT(IOST,1,2)="C-"
DO PAUSE1
+6 QUIT
SELTYP ;PEP;TO SELECT HEALTH SUMMARY TYPE
+1 KILL DIC
+2 SET DIC="^APCHSCTL("
SET DIC("A")="Select health summary type: "
SET DIC(0)="AEQM"
SET DIC("B")="ADULT REGULAR"
+3 WRITE !
+4 DO ^DIC
+5 KILL DIC,DA,DR
+6 IF Y<0
IF U[X
GOTO EXIT
GOTO SELTYP
+7 SET ACMSTYP=+Y
+8 QUIT
