Routine: ACMRL

ACMRL ; IHS/TUCSON/TMJ - CMS GENERAL RETRIEVAL DRIVER ; [ 02/10/2009  9:48 AM ]

 ;;2.0;ACM CASE MANAGEMENT SYSTEM;**8**;JAN 10, 1996

START ; PEP - GENERAL RETRIEVAL

 K ACMQUIT ;--- this variable controls whether or not a user terminated input

TYPE ;--- get register

 S (ACMPCNT,ACMPTCT)=0 ;ACMPTCT -- pt total for # of "V"isits

R ;lookup register

 I '$G(ACMRG) W !!,"OOPS, REGISTER NOT SELECTED!!" S ACMQUIT=1 G XIT

 D ADD I $D(ACMQUIT) D DEL K ACMQUIT G XIT

 I '$D(ACMCAND) D P1 Q

 D TITLE I $D(ACMQUIT) K ACMQUIT G TYPE

 D ZIS

P1 ;if patient, no prev defined report used

P11 K ^ACM(58.8,ACMRPT,11) D SCREEN I $D(ACMQUIT) K ACMQUIT D DEL G TYPE

P12 K ^ACM(58.8,ACMRPT,12) S ACMTCW=0 D COUNT I $D(ACMQUIT) K ACMQUIT G P11

P13 D TITLE I $D(ACMQUIT) K ACMQUIT G P12

 D SAVE,ZIS

SCREEN ;

 D SCREEN^ACMRL3

COUNT ;count only or detailed report

 D COUNT^ACMRL3

TITLE ;

 D TITLE^ACMRL3

SAVE ;

 D SAVE^ACMRL3

ZIS ;call to XBDBQUE

 I 'ACMTCW S ACMTCW=IOM

 S ACMDONE=""

 D SHOW^ACMRLS,SHOWP^ACMRLS,SHOWR^ACMRLS

 D XIT1

 S XBRP="^ACMRLP",XBRC="^ACMRL1",XBRX="XIT^ACMRL",XBNS="ACM"

 D ^XBDBQUE

 D XIT

DEL ;EP DELETE LOG ENTRY IF ONE EXISTS AND USER "^" OUT

 I $G(ACMRPT),$D(^ACM(58.8,ACMRPT,0)),'$P(^ACM(58.8,ACMRPT,0),U,2) S DIK="^ACM(58.8,",DA=ACMRPT D ^DIK K DIK,DA,DIC

ADD ;

 D ADD^ACMRL01

XIT ;

 D XIT^ACMRL1

XIT1 ;

 D XIT1^ACMRL1

DONE ;ENTRY POINT - END OF REPORT TIME DISPLAY

 I $D(ACMET) S ACMTS=(86400*($P(ACMET,",")-$P(ACMBT,",")))+($P(ACMET,",",2)-$P(ACMBT,",",2)),ACMH=$P(ACMTS/3600,".") S:ACMH="" ACMH=0 D

 .S ACMTS=ACMTS-(ACMH*3600),ACMM=$P(ACMTS/60,".") S:ACMM="" ACMM=0 S ACMTS=ACMTS-(ACMM*60),ACMS=ACMTS W !!,"RUN TIME (H.M.S): ",ACMH,".",ACMM,".",ACMS

 I $E(IOST)="C",IO=IO(0) S DIR(0)="EO",DIR("A")="End of report.  HIT RETURN" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 W:$D(IOF) @IOF

 K ACMTS,ACMS,ACMH,ACMM,ACMET

ACMRL     ; IHS/TUCSON/TMJ - CMS GENERAL RETRIEVAL DRIVER ; [ 02/10/2009  9:48 AM ]

 +1       ;;2.0;ACM CASE MANAGEMENT SYSTEM;**8**;JAN 10, 1996

START     ; PEP - GENERAL RETRIEVAL

 +1       ;--- this variable controls whether or not a user terminated input

           KILL ACMQUIT

TYPE      ;--- get register

 +1       ;ACMPTCT -- pt total for # of "V"isits

           SET (ACMPCNT,ACMPTCT)=0

R         ;lookup register

 +1        IF '$GET(ACMRG)

               WRITE !!,"OOPS, REGISTER NOT SELECTED!!"

               SET ACMQUIT=1

               GOTO XIT

 +2        DO ADD

           IF $DATA(ACMQUIT)

               DO DEL

               KILL ACMQUIT

               GOTO XIT

 +3        IF '$DATA(ACMCAND)

               DO P1

               QUIT

 +4        DO TITLE

           IF $DATA(ACMQUIT)

               KILL ACMQUIT

               GOTO TYPE

 +5        DO ZIS

 +6        QUIT

P1        ;if patient, no prev defined report used

P11        KILL ^ACM(58.8,ACMRPT,11)

           DO SCREEN

           IF $DATA(ACMQUIT)

               KILL ACMQUIT

               DO DEL

               GOTO TYPE

P12        KILL ^ACM(58.8,ACMRPT,12)

           SET ACMTCW=0

           DO COUNT

           IF $DATA(ACMQUIT)

               KILL ACMQUIT

               GOTO P11

P13        DO TITLE

           IF $DATA(ACMQUIT)

               KILL ACMQUIT

               GOTO P12

 +1        DO SAVE

           DO ZIS

 +2        QUIT

SCREEN    ;

 +1        DO SCREEN^ACMRL3

 +2        QUIT

COUNT     ;count only or detailed report

 +1        DO COUNT^ACMRL3

 +2        QUIT

TITLE     ;

 +1        DO TITLE^ACMRL3

 +2        QUIT

SAVE      ;

 +1        DO SAVE^ACMRL3

 +2        QUIT

ZIS       ;call to XBDBQUE

 +1        IF 'ACMTCW

               SET ACMTCW=IOM

 +2        SET ACMDONE=""

 +3        DO SHOW^ACMRLS

           DO SHOWP^ACMRLS

           DO SHOWR^ACMRLS

 +4        DO XIT1

 +5        SET XBRP="^ACMRLP"

           SET XBRC="^ACMRL1"

           SET XBRX="XIT^ACMRL"

           SET XBNS="ACM"

 +6        DO ^XBDBQUE

 +7        DO XIT

 +8        QUIT

DEL       ;EP DELETE LOG ENTRY IF ONE EXISTS AND USER "^" OUT

 +1        IF $GET(ACMRPT)

               IF $DATA(^ACM(58.8,ACMRPT,0))

                   IF '$PIECE(^ACM(58.8,ACMRPT,0),U,2)

                       SET DIK="^ACM(58.8,"

                       SET DA=ACMRPT

                       DO ^DIK

                       KILL DIK,DA,DIC

 +2        QUIT

ADD       ;

 +1        DO ADD^ACMRL01

 +2        QUIT

XIT       ;

 +1        DO XIT^ACMRL1

XIT1      ;

 +1        DO XIT1^ACMRL1

 +2        QUIT

DONE      ;ENTRY POINT - END OF REPORT TIME DISPLAY

 +1        IF $DATA(ACMET)

               SET ACMTS=(86400*($PIECE(ACMET,",")-$PIECE(ACMBT,",")))+($PIECE(ACMET,",",2)-$PIECE(ACMBT,",",2))

               SET ACMH=$PIECE(ACMTS/3600,".")

               IF ACMH=""

                   SET ACMH=0

               Begin DoDot:1

 +2                SET ACMTS=ACMTS-(ACMH*3600)

                   SET ACMM=$PIECE(ACMTS/60,".")

                   IF ACMM=""

                       SET ACMM=0

                   SET ACMTS=ACMTS-(ACMM*60)

                   SET ACMS=ACMTS

                   WRITE !!,"RUN TIME (H.M.S): ",ACMH,".",ACMM,".",ACMS

               End DoDot:1

 +3        IF $EXTRACT(IOST)="C"

               IF IO=IO(0)

                   SET DIR(0)="EO"

                   SET DIR("A")="End of report.  HIT RETURN"

                   DO ^DIR

                   KILL DIR

                   IF $DATA(DUOUT)

                       SET DIRUT=1

 +4        IF $DATA(IOF)

               WRITE @IOF

 +5        KILL ACMTS,ACMS,ACMH,ACMM,ACMET

 +6        QUIT

ACMRL.m