- 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
