Routine: APCM25E0

APCM25E0 ;IHS/CMI/LAB - IHS MU;

 ;;1.0;MU PERFORMANCE REPORTS;**8,9,10**;MAR 26, 2012;Build 31

 ;;;;;;Build 3

SC ;EP - TRANSITION OF CARE SUMMARY

 ;new logic for patch 8, keep old logic in case need to revert based on testing

 ;for each provider count each referral entry in ^BMCREF

 K ^TMP($J,"TRANS")

 NEW APCMLABS,MMR

 D TOCSUMC

 NEW APCMP,N,F,O,Y

 S (APCMD1,APCMN1)=0

 I APCMRPTT=1 S APCMP=0 F  S APCMP=$O(APCMPRV(APCMP)) Q:APCMP'=+APCMP  D

 .I $P($G(MMR(APCMP)),U,1)<100 D

 ..S F=$P(^APCM25OB(APCMIC,0),U,11) D S^APCM25E1(APCMRPT,APCMIC,"Provider is excluded from this measure as he/she had less than 1 referrals during the EHR reporting period.",APCMP,APCMRPTT,APCMTIME,F,1)

 .S F=$P(^APCM25OB(APCMIC,0),U,8)  ;denom field for this measure

 .S N=$P($G(MMR(APCMP)),U,1)  ;returns # of transS^# with mmr

 .D S^APCM25E1(APCMRPT,APCMIC,N,APCMP,APCMRPTT,APCMTIME,F)

 .;now set patient list for this provider

 .S P=0 F  S P=$O(^TMP($J,"TRANS",APCMP,P)) Q:P'=+P  D

 ..I $P(^TMP($J,"TRANS",APCMP,P),U,1)=$P(^TMP($J,"TRANS",APCMP,P),U,2) S APCMVALU="# referrals: "_$P(^TMP($J,"TRANS",APCMP,P),U,1)_"|||"_" # w/TOCS: "_+$P(^TMP($J,"TRANS",APCMP,P),U,2)_" "_$P(^TMP($J,"TRANS",APCMP,P),U,3)_"|||1" D  Q

 ...S DFN=P D SETLIST^APCM25E1 Q

 ..S DFN=P,APCMVALU="# referrals: "_$P(^TMP($J,"TRANS",APCMP,P),U,1)_"|||"_" # w/TOCS: "_+$P(^TMP($J,"TRANS",APCMP,P),U,2)_" "_$P(^TMP($J,"TRANS",APCMP,P),U,3)_"|||0" D SETLIST^APCM25E1

 .S Y=APCMIC

 .S F=$P(^APCM25OB(Y,0),U,9)

 .S N=$P($G(MMR(APCMP)),U,2)

 .D S^APCM25E1(APCMRPT,APCMIC,N,APCMP,APCMRPTT,APCMTIME,F)

 I APCMRPTT=2 S APCMP=APCMFAC  D

 .;I '$P($G(MMR(APCMP)),U,1) D  Q

 .;.S F=$P(^APCM25OB(APCMIC,0),U,11) D S^APCM25E1(APCMRPT,APCMIC,"Facility is excluded from this measure as there were no referrals during the EHR reporting period.",APCMP,APCMRPTT,APCMTIME,F,1)

 .;set denominator value into field FOR measure 1

 .S F=$P(^APCM25OB(APCMIC,0),U,8)  ;denom field for this measure

 .S N=$P($G(MMR(APCMP)),U,1)  ;returns # of transS^# with mmr

 .D S^APCM25E1(APCMRPT,APCMIC,N,APCMP,APCMRPTT,APCMTIME,F)

 .;now set patient list for this provider

 .S P=0 F  S P=$O(^TMP($J,"TRANS",APCMP,P)) Q:P'=+P  D

 ..I $P(^TMP($J,"TRANS",APCMP,P),U,1)=$P(^TMP($J,"TRANS",APCMP,P),U,2) S APCMVALU="# referrals: "_$P(^TMP($J,"TRANS",APCMP,P),U,1)_"|||"_" # w/TOCS: "_+$P(^TMP($J,"TRANS",APCMP,P),U,2)_" "_$P(^TMP($J,"TRANS",APCMP,P),U,3)_"|||1" D  Q

 ...S DFN=P D SETLIST^APCM25E1 Q

 ..S DFN=P,APCMVALU="# referrals: "_$P(^TMP($J,"TRANS",APCMP,P),U,1)_"|||"_" # w/TOCS: "_+$P(^TMP($J,"TRANS",APCMP,P),U,2)_" "_$P(^TMP($J,"TRANS",APCMP,P),U,3)_"|||0" D SETLIST^APCM25E1

 .;numerator?

 .;NOW SET VALUES FOR NUMERATOR

 .S Y=APCMIC

 .;S F=$P(^APCM25OB(Y,0),U,8) D S^APCM25E1(APCMRPT,Y,$P($G(MMR(APCMP)),U,1),APCMP,APCMRPTT,APCMTIME,F)

 .S F=$P(^APCM25OB(Y,0),U,9)

 .S N=$P($G(MMR(APCMP)),U,2)

 .D S^APCM25E1(APCMRPT,APCMIC,N,APCMP,APCMRPTT,APCMTIME,F)

 K ^TMP($J,"TRANS")

TOCSUMC ;EP - ep toc

 ;SET ARRAY MMR to MMR(prov ien)=denom^numer

 ;DENOM=# VISITS W/REFERRAL

 ;NUMER=# W/TOC DOCUMENT IN 600 MULTIPLE

 ;IF DENOM =0 THEN PROVIDER EXCLUSION

 NEW T,C,PAT,N,APCMX,R,C,G,Z,S,B,E,J,K,APCMED,APCMBD

 S C=0,N=0,PAT=""

 S T=$O(^APCMMUCN("B","MODIFIED STAGE 2 2015",0))

 S APCMBD=$$FMADD^XLFDT(APCMBDAT,-1)

 S APCMED=APCMEDAT

 ;loop all referrals initiated in the time period

 F  S APCMBD=$O(^BMCREF("B",APCMBD)) Q:APCMBD'=+APCMBD!(APCMBD>APCMED)  D

 .S APCMX=0 F  S APCMX=$O(^BMCREF("B",APCMBD,APCMX)) Q:APCMX'=+APCMX  D

 ..;check .06 to make sure it is provider we are running the report for in APCMPRV array

 ..S R=$$VALI^XBDIQ1(90001,APCMX,.06)

 ..I APCMRPTT=1 I 'R Q  ;IN EP AND NO PROVIDER

 ..I APCMRPTT=1 I '$D(APCMPRV(R)) Q  ;IN EP AND NOT CORRECT PROVIDER

 ..I APCMRPTT=2 Q:$$VALI^XBDIQ1(90001,APCMX,.05)'=APCMFAC

 ..Q:$P(^BMCREF(APCMX,0),U,4)="N"  ;NO INHOUSE

 ..S D=$P($G(^BMCREF(APCMX,13)),U,5)  ;approval date

 ..Q:D=""  ;NO APPROVAL DATE

 ..Q:D>APCMEDAT  ;AFTER TP APPROVAL DATE MUST BE IN TIME PERIOD

 ..Q:D<APCMBDAT  ;BEFORE TP

 ..Q:$$VAL^XBDIQ1(90001,APCMX,.13)="DIAGNOSTIC IMAGING"

 ..Q:$$VAL^XBDIQ1(90001,APCMX,.13)="PATHOLOGY AND LABORATORY"

 ..Q:$$VAL^XBDIQ1(90001,APCMX,.13)="TRANSPORTATION"

 ..Q:$$VAL^XBDIQ1(90001,APCMX,.13)="DURABLE MEDICAL EQUIPMENT"

 ..;get visit and exclude clinic 30 and H for EP report

 ..;do hoser for inpatient

 ..S V=$$VALI^XBDIQ1(90001,APCMX,1303)  ;V REF IEN

 ..I 'V Q  ;NO V REFERRAL???

 ..S V=$$VALI^XBDIQ1(9000010.59,V,.03)

 ..I 'V Q  ;;WHY WOULD THERE BE NO VISIT??

 ..Q:'$D(^AUPNVSIT(V,0))  ;NO VISIT??

 ..I APCMRPTT=2,APCMMETH="E" Q:'$$HOSER^APCM25E6(V,APCMFAC)  S R=APCMFAC G TOCS2

 ..I APCMRPTT=2,APCMMETH="O" Q:"OH"'[$P(^AUPNVSIT(V,0),U,7)  Q:$P(^AUPNVSIT(V,0),U,6)'=APCMFAC  S R=APCMFAC G TOCS2

 ..I APCMRPTT=2 Q

 ..Q:$P(^AUPNVSIT(V,0),U,7)="H"  ;Q:$P(^AUPNVSIT(V,0),U,7)="O"

 ..S C=$$CLINIC^APCLV(V,"C")

 ..Q:C=30

TOCS2 ..;

 ..S PAT=$$VALI^XBDIQ1(90001,APCMX,.03)

SUMNUM ..;

 ..I '$D(MMR(R)) S MMR(R)=""

 ..S $P(MMR(R),U,1)=$P(MMR(R),U,1)+1 D

 ...S $P(^TMP($J,"TRANS",R,PAT),U,1)=$P($G(^TMP($J,"TRANS",R,PAT)),U,1)+1

 ...S $P(^TMP($J,"TRANS",R,PAT),U,3)=$P(^TMP($J,"TRANS",R,PAT),U,3)_" "_$$VAL^XBDIQ1(90001,APCMX,.01)_"-"_$P(^BMCREF(APCMX,0),U,2)

 ..;now check numerator, FIELD 600

 ..S G=0,T=0

 ..;FIRST LOOK FOR A TX AND ACKNOWLEDGED IF FOUND, USE IT

 ..;NEXT LOOK FOR A TX, IF FOUND, USE IT

 ..S B=0 F  S B=$O(^BMCREF(APCMX,6,B)) Q:B'=+B!(G)  D

 ...S (A,E)=""

 ...I $P(^BMCREF(APCMX,6,B,0),U,4)'="CT" Q

 ...S E=$P($P(^BMCREF(APCMX,6,B,0),U,1),".")

 ...I E="" Q  ;NO .01

 ...I $G(APCMEDUD),E>APCMEDUD Q  ;IHS/CMI/LAB - PATCH 9 - printed after 12/31/17

 ...S M=$$CD(E,APCMBD)

 ...I 'M Q  ;NOT IN REPORTING YEAR

 ...;I 'M S E=$P($P(^BMCREF(APCMX,6,B,0),U,1),".") S M=$$CD(E) Q:'M  ;dates aren't good

 ...S A=$P($P(^BMCREF(APCMX,6,B,0),U,3),".")  ;tx acknowledged

 ...I $G(APCMEDUD),A,A>APCMEDUD Q  ;IHS/CMI/LAB - PATCH 9 in 2017, acknowledged after 12/31/17

 ...I A,$$CD(A,APCMBD) D SN S G=1

SN ;

 S $P(MMR(R),U,2)=$P(MMR(R),U,2)+1 D  Q

 .S $P(^TMP($J,"TRANS",R,PAT),U,2)=$P($G(^TMP($J,"TRANS",R,PAT)),U,2)+1

 .S $P(^TMP($J,"TRANS",R,PAT),U,3)=$P(^TMP($J,"TRANS",R,PAT),U,3)_";YES TX AND ACK"

 .;S $P(MMR(R),U,5)=$P(MMR(R),U,5)+1

CD(E,BD) ;

 I E="" Q 0  ;NO DATE TRANSMITTED

 NEW %

 S %=$E(BD,1,3)_"0101"

 I $P(E,".")<% Q 0

Q 1

APCM25E0  ;IHS/CMI/LAB - IHS MU;

 +1       ;;1.0;MU PERFORMANCE REPORTS;**8,9,10**;MAR 26, 2012;Build 31

 +2       ;;;;;;Build 3

SC        ;EP - TRANSITION OF CARE SUMMARY

 +1       ;new logic for patch 8, keep old logic in case need to revert based on testing

 +2       ;for each provider count each referral entry in ^BMCREF

 +3        KILL ^TMP($JOB,"TRANS")

 +4        NEW APCMLABS,MMR

 +5        DO TOCSUMC

 +6        NEW APCMP,N,F,O,Y

 +7        SET (APCMD1,APCMN1)=0

 +8        IF APCMRPTT=1

               SET APCMP=0

FOR

                   SET APCMP=$ORDER(APCMPRV(APCMP))

                   IF APCMP'=+APCMP

                       QUIT

                   Begin DoDot:1

 +9                    IF $PIECE($GET(MMR(APCMP)),U,1)<100

                           Begin DoDot:2

 +10                           SET F=$PIECE(^APCM25OB(APCMIC,0),U,11)

                               DO S^APCM25E1(APCMRPT,APCMIC,"Provider is excluded from this measure as he/she had less than 1 referrals during the EHR reporting period.",APCMP,APCMRPTT,APCMTIME,F,1)

                           End DoDot:2

 +11      ;denom field for this measure

                       SET F=$PIECE(^APCM25OB(APCMIC,0),U,8)

 +12      ;returns # of transS^# with mmr

                       SET N=$PIECE($GET(MMR(APCMP)),U,1)

 +13                   DO S^APCM25E1(APCMRPT,APCMIC,N,APCMP,APCMRPTT,APCMTIME,F)

 +14      ;now set patient list for this provider

 +15                   SET P=0

FOR

                           SET P=$ORDER(^TMP($JOB,"TRANS",APCMP,P))

                           IF P'=+P

                               QUIT

                           Begin DoDot:2

 +16                           IF $PIECE(^TMP($JOB,"TRANS",APCMP,P),U,1)=$PIECE(^TMP($JOB,"TRANS",APCMP,P),U,2)

                                   SET APCMVALU="# referrals: "_$PIECE(^TMP($JOB,"TRANS",APCMP,P),U,1)_"|||"_" # w/TOCS: "_+$PIECE(^TMP($JOB,"TRANS",APCMP,P),U,2)_" "_$PIECE(^TMP($JOB,"TRANS",APCMP,P),U,3)_"|||1"

                                   Begin DoDot:3

 +17                                   SET DFN=P

                                       DO SETLIST^APCM25E1

                                       QUIT

                                   End DoDot:3

                                   QUIT

 +18                           SET DFN=P

                               SET APCMVALU="# referrals: "_$PIECE(^TMP($JOB,"TRANS",APCMP,P),U,1)_"|||"_" # w/TOCS: "_+$PIECE(^TMP($JOB,"TRANS",APCMP,P),U,2)_" "_$PIECE(^TMP($JOB,"TRANS",APCMP,P),U,3)_"|||0"

                               DO SETLIST^APCM25E1

                           End DoDot:2

 +19                   SET Y=APCMIC

 +20                   SET F=$PIECE(^APCM25OB(Y,0),U,9)

 +21                   SET N=$PIECE($GET(MMR(APCMP)),U,2)

 +22                   DO S^APCM25E1(APCMRPT,APCMIC,N,APCMP,APCMRPTT,APCMTIME,F)

                   End DoDot:1

 +23       IF APCMRPTT=2

               SET APCMP=APCMFAC

               Begin DoDot:1

 +24      ;I '$P($G(MMR(APCMP)),U,1) D  Q

 +25      ;.S F=$P(^APCM25OB(APCMIC,0),U,11) D S^APCM25E1(APCMRPT,APCMIC,"Facility is excluded from this measure as there were no referrals during the EHR reporting period.",APCMP,APCMRPTT,APCMTIME,F,1)

 +26      ;set denominator value into field FOR measure 1

 +27      ;denom field for this measure

                   SET F=$PIECE(^APCM25OB(APCMIC,0),U,8)

 +28      ;returns # of transS^# with mmr

                   SET N=$PIECE($GET(MMR(APCMP)),U,1)

 +29               DO S^APCM25E1(APCMRPT,APCMIC,N,APCMP,APCMRPTT,APCMTIME,F)

 +30      ;now set patient list for this provider

 +31               SET P=0

FOR

                       SET P=$ORDER(^TMP($JOB,"TRANS",APCMP,P))

                       IF P'=+P

                           QUIT

                       Begin DoDot:2

 +32                       IF $PIECE(^TMP($JOB,"TRANS",APCMP,P),U,1)=$PIECE(^TMP($JOB,"TRANS",APCMP,P),U,2)

                               SET APCMVALU="# referrals: "_$PIECE(^TMP($JOB,"TRANS",APCMP,P),U,1)_"|||"_" # w/TOCS: "_+$PIECE(^TMP($JOB,"TRANS",APCMP,P),U,2)_" "_$PIECE(^TMP($JOB,"TRANS",APCMP,P),U,3)_"|||1"

                               Begin DoDot:3

 +33                               SET DFN=P

                                   DO SETLIST^APCM25E1

                                   QUIT

                               End DoDot:3

                               QUIT

 +34                       SET DFN=P

                           SET APCMVALU="# referrals: "_$PIECE(^TMP($JOB,"TRANS",APCMP,P),U,1)_"|||"_" # w/TOCS: "_+$PIECE(^TMP($JOB,"TRANS",APCMP,P),U,2)_" "_$PIECE(^TMP($JOB,"TRANS",APCMP,P),U,3)_"|||0"

                           DO SETLIST^APCM25E1

                       End DoDot:2

 +35      ;numerator?

 +36      ;NOW SET VALUES FOR NUMERATOR

 +37               SET Y=APCMIC

 +38      ;S F=$P(^APCM25OB(Y,0),U,8) D S^APCM25E1(APCMRPT,Y,$P($G(MMR(APCMP)),U,1),APCMP,APCMRPTT,APCMTIME,F)

 +39               SET F=$PIECE(^APCM25OB(Y,0),U,9)

 +40               SET N=$PIECE($GET(MMR(APCMP)),U,2)

 +41               DO S^APCM25E1(APCMRPT,APCMIC,N,APCMP,APCMRPTT,APCMTIME,F)

               End DoDot:1

 +42       KILL ^TMP($JOB,"TRANS")

 +43       QUIT

TOCSUMC   ;EP - ep toc

 +1       ;SET ARRAY MMR to MMR(prov ien)=denom^numer

 +2       ;DENOM=# VISITS W/REFERRAL

 +3       ;NUMER=# W/TOC DOCUMENT IN 600 MULTIPLE

 +4       ;IF DENOM =0 THEN PROVIDER EXCLUSION

 +5        NEW T,C,PAT,N,APCMX,R,C,G,Z,S,B,E,J,K,APCMED,APCMBD

 +6        SET C=0

           SET N=0

           SET PAT=""

 +7        SET T=$ORDER(^APCMMUCN("B","MODIFIED STAGE 2 2015",0))

 +8        SET APCMBD=$$FMADD^XLFDT(APCMBDAT,-1)

 +9        SET APCMED=APCMEDAT

 +10      ;loop all referrals initiated in the time period

 +11       FOR

               SET APCMBD=$ORDER(^BMCREF("B",APCMBD))

               IF APCMBD'=+APCMBD!(APCMBD>APCMED)

                   QUIT

               Begin DoDot:1

 +12               SET APCMX=0

FOR

                       SET APCMX=$ORDER(^BMCREF("B",APCMBD,APCMX))

                       IF APCMX'=+APCMX

                           QUIT

                       Begin DoDot:2

 +13      ;check .06 to make sure it is provider we are running the report for in APCMPRV array

 +14                       SET R=$$VALI^XBDIQ1(90001,APCMX,.06)

 +15      ;IN EP AND NO PROVIDER

                           IF APCMRPTT=1

                               IF 'R

                                   QUIT

 +16      ;IN EP AND NOT CORRECT PROVIDER

                           IF APCMRPTT=1

                               IF '$DATA(APCMPRV(R))

                                   QUIT

 +17                       IF APCMRPTT=2

                               IF $$VALI^XBDIQ1(90001,APCMX,.05)'=APCMFAC

                                   QUIT

 +18      ;NO INHOUSE

                           IF $PIECE(^BMCREF(APCMX,0),U,4)="N"

                               QUIT

 +19      ;approval date

                           SET D=$PIECE($GET(^BMCREF(APCMX,13)),U,5)

 +20      ;NO APPROVAL DATE

                           IF D=""

                               QUIT

 +21      ;AFTER TP APPROVAL DATE MUST BE IN TIME PERIOD

                           IF D>APCMEDAT

                               QUIT

 +22      ;BEFORE TP

                           IF D<APCMBDAT

                               QUIT

 +23                       IF $$VAL^XBDIQ1(90001,APCMX,.13)="DIAGNOSTIC IMAGING"

                               QUIT

 +24                       IF $$VAL^XBDIQ1(90001,APCMX,.13)="PATHOLOGY AND LABORATORY"

                               QUIT

 +25                       IF $$VAL^XBDIQ1(90001,APCMX,.13)="TRANSPORTATION"

                               QUIT

 +26                       IF $$VAL^XBDIQ1(90001,APCMX,.13)="DURABLE MEDICAL EQUIPMENT"

                               QUIT

 +27      ;get visit and exclude clinic 30 and H for EP report

 +28      ;do hoser for inpatient

 +29      ;V REF IEN

                           SET V=$$VALI^XBDIQ1(90001,APCMX,1303)

 +30      ;NO V REFERRAL???

                           IF 'V

                               QUIT

 +31                       SET V=$$VALI^XBDIQ1(9000010.59,V,.03)

 +32      ;;WHY WOULD THERE BE NO VISIT??

                           IF 'V

                               QUIT

 +33      ;NO VISIT??

                           IF '$DATA(^AUPNVSIT(V,0))

                               QUIT

 +34                       IF APCMRPTT=2

                               IF APCMMETH="E"

                                   IF '$$HOSER^APCM25E6(V,APCMFAC)

                                       QUIT

                                   SET R=APCMFAC

                                   GOTO TOCS2

 +35                       IF APCMRPTT=2

                               IF APCMMETH="O"

                                   IF "OH"'[$PIECE(^AUPNVSIT(V,0),U,7)

                                       QUIT

                                   IF $PIECE(^AUPNVSIT(V,0),U,6)'=APCMFAC

                                       QUIT

                                   SET R=APCMFAC

                                   GOTO TOCS2

 +36                       IF APCMRPTT=2

                               QUIT

 +37      ;Q:$P(^AUPNVSIT(V,0),U,7)="O"

                           IF $PIECE(^AUPNVSIT(V,0),U,7)="H"

                               QUIT

 +38                       SET C=$$CLINIC^APCLV(V,"C")

 +39                       IF C=30

                               QUIT

TOCS2     ;

 +1                        SET PAT=$$VALI^XBDIQ1(90001,APCMX,.03)

SUMNUM    ;

 +1                        IF '$DATA(MMR(R))

                               SET MMR(R)=""

 +2                        SET $PIECE(MMR(R),U,1)=$PIECE(MMR(R),U,1)+1

                           Begin DoDot:3

 +3                            SET $PIECE(^TMP($JOB,"TRANS",R,PAT),U,1)=$PIECE($GET(^TMP($JOB,"TRANS",R,PAT)),U,1)+1

 +4                            SET $PIECE(^TMP($JOB,"TRANS",R,PAT),U,3)=$PIECE(^TMP($JOB,"TRANS",R,PAT),U,3)_" "_$$VAL^XBDIQ1(90001,APCMX,.01)_"-"_$PIECE(^BMCREF(APCMX,0),U,2)

                           End DoDot:3

 +5       ;now check numerator, FIELD 600

 +6                        SET G=0

                           SET T=0

 +7       ;FIRST LOOK FOR A TX AND ACKNOWLEDGED IF FOUND, USE IT

 +8       ;NEXT LOOK FOR A TX, IF FOUND, USE IT

 +9                        SET B=0

FOR

                               SET B=$ORDER(^BMCREF(APCMX,6,B))

                               IF B'=+B!(G)

                                   QUIT

                               Begin DoDot:3

 +10                               SET (A,E)=""

 +11                               IF $PIECE(^BMCREF(APCMX,6,B,0),U,4)'="CT"

                                       QUIT

 +12                               SET E=$PIECE($PIECE(^BMCREF(APCMX,6,B,0),U,1),".")

 +13      ;NO .01

                                   IF E=""

                                       QUIT

 +14      ;IHS/CMI/LAB - PATCH 9 - printed after 12/31/17

                                   IF $GET(APCMEDUD)

                                       IF E>APCMEDUD

                                           QUIT

 +15                               SET M=$$CD(E,APCMBD)

 +16      ;NOT IN REPORTING YEAR

                                   IF 'M

                                       QUIT

 +17      ;I 'M S E=$P($P(^BMCREF(APCMX,6,B,0),U,1),".") S M=$$CD(E) Q:'M  ;dates aren't good

 +18      ;tx acknowledged

                                   SET A=$PIECE($PIECE(^BMCREF(APCMX,6,B,0),U,3),".")

 +19      ;IHS/CMI/LAB - PATCH 9 in 2017, acknowledged after 12/31/17

                                   IF $GET(APCMEDUD)

                                       IF A

                                           IF A>APCMEDUD

                                               QUIT

 +20                               IF A

                                       IF $$CD(A,APCMBD)

                                           DO SN

                                           SET G=1

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +21       QUIT

SN        ;

 +1        SET $PIECE(MMR(R),U,2)=$PIECE(MMR(R),U,2)+1

           Begin DoDot:1

 +2            SET $PIECE(^TMP($JOB,"TRANS",R,PAT),U,2)=$PIECE($GET(^TMP($JOB,"TRANS",R,PAT)),U,2)+1

 +3            SET $PIECE(^TMP($JOB,"TRANS",R,PAT),U,3)=$PIECE(^TMP($JOB,"TRANS",R,PAT),U,3)_";YES TX AND ACK"

 +4       ;S $P(MMR(R),U,5)=$P(MMR(R),U,5)+1

           End DoDot:1

           QUIT

 +5        QUIT

CD(E,BD)  ;

 +1       ;NO DATE TRANSMITTED

           IF E=""

               QUIT 0

 +2        NEW %

 +3        SET %=$EXTRACT(BD,1,3)_"0101"

 +4        IF $PIECE(E,".")<%

               QUIT 0

 +5        QUIT 1

APCM25E0.m