BGPMUH05 ;IHS/MSC/MGH - MI measure NQF0437-STK-4 ;02-Mar-2011 16:05;MGH
;;11.0;IHS CLINICAL REPORTING;**4**;JAN 06, 2011;Build 84
;ED meaningful use hospital measured
ENTRY ;PEP Stroke Measure 4 - tPA therapy within 3hrs
N START,END,BGPIEN,DFN,BGPVST,BGPISDX,BGPHSDX,BGPAGEE,BGPIPROB,BGPHPROB,STROKE,EXC,NUM,BGPDIS
N BGPER,BGPADTMI,BDPDD,LKW
;Start by finding all admissions during the reporting period
S START=BGPBDATE
S END=BGPEDATE_".2359"
F S START=$O(^DGPM("B",START)) Q:START=""!(START>END) D
.S BGPIEN="" F S BGPIEN=$O(^DGPM("B",START,BGPIEN)) Q:BGPIEN="" D
..Q:$P($G(^DGPM(BGPIEN,0)),U,2)'=1 ;Only include admissions
..S DFN=$P($G(^DGPM(BGPIEN,0)),U,3)
..S BGPAGEE=$$AGE^AUPNPAT(DFN,BGPEDATE)
..Q:DFN=""
..S BGPACTUP=$$ACTUPAP^BGPMUEHD(DFN,BGPBDATE,BGPEDATE,BGPBEN)
..I 'BGPACTUP,'$G(BGPXPXPX),'$G(BGPIISO) Q
..S BGPVST=$P($G(^DGPM(BGPIEN,0)),U,27) ;Get the visit
..Q:BGPVST=""
..S BGPDIS=$P($G(^DGPM(BGPIEN,0)),U,17) ;Don't use if pt is still an inpt
..Q:BGPDIS=""
..;Check for a diagnosis of stroke
..S STROKE=0,EXC=0,NUM=0
..S BGPISDX=$$VSTPOVA^BGPMUUT3(DFN,BGPVST,"BGPMU ISCHEMIC STROKE DX")
..;S BGPIPROB=$$PLTAX^BGPMUUT1(DFN,"BGPMU ISCHEMIC STROKE DX","A")
..;Pt must have both a POV of stoke and it must be an active problem
..;I +BGPISDX&(+BGPIPROB) S STROKE=1
..I +BGPISDX S STROKE=1
..I +STROKE D
...;Get the admit time & discharge times
...S BGPADMIT=$P($G(^DGPM(BGPIEN,0)),U,1)
...S BGPDD=$P($G(^DGPM(BGPDIS,0)),U,1)
...;See if there is an ER visit prior to admission
...S BGPER=$$ER(DFN,BGPADMIT)
...S EXC=$$EXCLUDE(DFN,BGPIEN,BGPVST,BGPDIS)
...;Find the date/time of last known well
...S LKW=$$WELL(DFN,BGPER,BGPADMIT,BGPDD)
...I LKW=0 S EXC="1^LKW"
...;If no exclusions see if they had tPA given in correct time frame
...I EXC="" S NUM=$$NUMER(DFN,LKW)
...;Now add it all up
...D TOTAL(BGPIEN)
Q
TOTAL(BGPIEN) ;add up the totals
N PTCNT,EXCCT,DENCT,NUMCT,TOTALS,DATE,NOTCT
S TOTALS=$G(^TMP("BGPMU0437",$J,BGPMUTF,"TOT"))
S DENCT=+$G(^TMP("BGPMU0437",$J,BGPMUTF,"DEN"))
S NUMCT=+$G(^TMP("BGPMU0437",$J,BGPMUTF,"NUM"))
S EXCCT=+$G(^TMP("BGPMU0437",$J,BGPMUTF,"EXC"))
S NOTCT=+$G(^TMP("BGPMU0437",$J,BGPMUTF,"NOT"))
S PTCNT=TOTALS
S PTCNT=PTCNT+1
S DATE=$$DATE^BGPMUUTL($P($G(^DGPM(BGPIEN,0)),U,1))
S DENCT=DENCT+1 S ^TMP("BGPMU0437",$J,BGPMUTF,"DEN")=DENCT
I EXC'="" D
.S EXCCT=EXCCT+1 S ^TMP("BGPMU0437",$J,BGPMUTF,"EXC")=EXCCT
.I BGPMUTF="C" S ^TMP("BGPMU0437",$J,"PAT",BGPMUTF,"EXC",PTCNT)=DFN_U_DATE_U_$P(EXC,U,2)
I EXC="" D
.I +NUM=1 D
..S NUMCT=NUMCT+1 S ^TMP("BGPMU0437",$J,BGPMUTF,"NUM")=NUMCT
..S ^TMP("BGPMU0437",$J,"PAT",BGPMUTF,"NUM",PTCNT)=DFN_U_DATE_U_$P(NUM,U,3)_U_$P(NUM,U,2)
.I +NUM=0 D
..S ^TMP("BGPMU0437",$J,"PAT",BGPMUTF,"NOT",PTCNT)=DFN_U_DATE_U_$P(NUM,U,3)_U_$P(NUM,U,2)
..S NOTCT=NOTCT+1 S ^TMP("BGPMU0437",$J,BGPMUTF,"NOT")=NOTCT
S ^TMP("BGPMU0437",$J,BGPMUTF,"TOT")=PTCNT
S BGPICARE("MU.STK.0437.1",BGPMUTF,DFN)=1_U_+$G(NUM)_U_+EXC_U_DATE_";"_$P($G(NUM),U,3)_";"_$P(EXC,U,2)
Q
EXCLUDE(DFN,BGPIEN,BGPVST,BGPDIS) ;See if there are exclusions
N REASON,BGPLOS,BGPHOS,BGPCLIN,BGPECI,DTYPE1,DTYPE2,BGPALL,BGPREF,NOXTHROM,NODTHROM,NOPTHROM
S REASON=""
I BGPAGEE<18 S REASON="1^AGE" Q REASON
;Check for LOS
S BGPLOS=$$LOS^BGPMUH08(BGPIEN,BGPDIS)
I BGPLOS>120 S REASON="1^LOS" Q REASON
;Check for clinical trial
S BGPCLIN=$$TRIAL^BGPMUH08(DFN,BGPVST)
I +BGPCLIN S REASON=BGPCLIN Q REASON
;Check for elective carotid intervention procedure
S BGPECI=$$ELECTIVE^BGPMUH08(DFN,BGPVST,BGPIEN)
I +BGPECI S REASON=BGPECI Q REASON
;Check for refusals
S BGPREF=$$REF(DFN,BGPVST,BGPDIS)
I +BGPREF S REASON=BGPREF Q REASON
;Check for reasons not initiated
; Check for CPT procedure within the past 180 days
S BGPDISDT=$P($P($G(^DGPM(BGPDIS,0)),U,1),".",1)
S BGPDD180=$$FMADD^XLFDT(BGPDISDT,-180)
S NOXTHROM=$$CPT^BGPMUUT1(DFN,BGPDD180,BGPDISDT,"BGPMU WARFARIN THERAPY CPT")
I +NOXTHROM S REASON=NOXTHROM Q REASON
; Check for POV within the past 180 days
S NODTHROM=$$LASTDX^BGPMUUT2(DFN,BGPDD180,BGPDISDT,"BGPMU WARFARIN THERAPY ICD")
I +NODTHROM S REASON=NODTHROM Q REASON
; Check for Problem doc'd within the past 180 days
S NOPTHROM=$$PLTAX^BGPMUUT1(DFN,"BGPMU WARFARIN THERAPY ICD","C")
I +NOPTHROM D
.S PDATE=$P(NOPTHROM,U,3)
.I PDATE>BGPDD180 S REASON=1_U_$P(NOPTHROM,U,2)_" "_$$DATE^BGPMUUTL($P(NOPTHROM,U,3))
Q REASON
REF(DFN,BGPVST,BGPDIS) ;Find refuals for this medication
N ENDDT,X1,X2,X,MED,BGPEVT,DISDT
S MED=0
S BGPEVT=$P($G(^AUPNVSIT(BGPVST,0)),U,1)
S DISDT=$P($G(^DGPM(BGPDIS,0)),U,1)
S ENDDT=$$FMADD^XLFDT(DISDT,+1)
S TAX="BGPMU TPA NDC CODES"
S MED=$$MEDREF^BGPMUUT2(DFN,BGPEVT,ENDDT,TAX)
Q MED
NUMER(DFN,LKW) ;Check to see if pt is in the numerator
N TAX,MEDDTE,ENDDT,TPA,MEDIEN,STATUS,DRUG,DISPENSE
S TPA=0
S MEDDTE=$P(LKW,U,2) ;Start time is last known well
S ENDDT=$$FMADD^XLFDT(MEDDTE,+1) ;Don't search more than 24hrs
F S MEDDTE=$O(^PSB(53.79,"AADT",DFN,MEDDTE)) Q:'+MEDDTE!(MEDDTE>ENDDT)!(+TPA) D
.S MEDIEN="" F S MEDIEN=$O(^PSB(53.79,"AADT",DFN,MEDDTE,MEDIEN)) Q:'+MEDIEN!(+TPA) D
..S STATUS=$P($G(^PSB(53.79,MEDIEN,0)),U,9)
..I STATUS="G"!(STATUS="I")!(STATUS="C") D ;Drug given
...S TIME=$$FMDIFF^XLFDT(MEDDTE,$P(LKW,U,2),1) ;Lapsed time in seconds
...I (TIME\60)<180 D
....S DISPENSE=0 F S DISPENSE=$O(^PSB(53.79,MEDIEN,.5,DISPENSE)) Q:'+DISPENSE!(+TPA) D
.....S DRUG=$G(^PSB(53.79,MEDIEN,.5,DISPENSE,0))
.....S DRUG=$P(DRUG,U,1)
.....S TAX="BGPMU TPA NDC CODES"
.....S TPA=$$NDC^BGPMUUT4(DRUG,TAX)
.....S:+TPA $P(TPA,U,3)=BGPDD
Q TPA
ER(DFN,BGPADMIT,BGPVST) ;Find ER admit time since TPA is often given in the ER
N VST,IEN,FOUND,ERDTE,NEW
S FOUND=0,VST=0
S IEN="" F S IEN=$O(^AMERVSIT("AC",DFN,IEN),-1) Q:IEN=""!(+FOUND) D
.S ERDTE=$P($G(^AMERVSIT(IEN,0)),U,1)
.S NEW=$$FMADD^XLFDT(BGPADMIT,-1)
.I ERDTE>NEW&(ERDTE<BGPADMIT) S FOUND=1,VST=ERDTE
Q VST
WELL(DFN,BGPER,BGPADMIT,BGPDD) ;Find is pt has a last known well
N IEN,MSR,MTYP,LKW,CNT,TIME,X1,INVD
S LKW="",CNT=0
S MTYP="" S MTYP=$O(^AUTTMSR("B","LKW",MTYP))
Q:MTYP="" 0
S INVD="" F S INVD=$O(^AUPNVMSR("AE",DFN,MTYP,INVD)) Q:INVD=""!(+CNT) D
.S MSR="" F S MSR=$O(^AUPNVMSR("AE",DFN,MTYP,INVD,MSR)) Q:MSR=""!(+CNT) D
..I $P($G(^AUPNVMSR(MSR,0)),U,1)=MTYP D
...S TIME=$P($G(^AUPNVMSR(MSR,12)),U,1)
...Q:TIME>BGPDD
...S X1=$$FMDIFF^XLFDT(BGPER,TIME,2) I (X1\60)<120 S CNT=1_U_TIME_"^ER" Q
...S X1=$$FMDIFF^XLFDT(BGPADMIT,TIME,2) I (X1\60)<120 S CNT=1_U_TIME_"^AD" Q
...I TIME>BGPADMIT S CNT=1_U_TIME_"^IN"
Q CNT
BGPMUH05 ;IHS/MSC/MGH - MI measure NQF0437-STK-4 ;02-Mar-2011 16:05;MGH
+1 ;;11.0;IHS CLINICAL REPORTING;**4**;JAN 06, 2011;Build 84
+2 ;ED meaningful use hospital measured
ENTRY ;PEP Stroke Measure 4 - tPA therapy within 3hrs
+1 NEW START,END,BGPIEN,DFN,BGPVST,BGPISDX,BGPHSDX,BGPAGEE,BGPIPROB,BGPHPROB,STROKE,EXC,NUM,BGPDIS
+2 NEW BGPER,BGPADTMI,BDPDD,LKW
+3 ;Start by finding all admissions during the reporting period
+4 SET START=BGPBDATE
+5 SET END=BGPEDATE_".2359"
+6 FOR
SET START=$ORDER(^DGPM("B",START))
IF START=""!(START>END)
QUIT
Begin DoDot:1
+7 SET BGPIEN=""
FOR
SET BGPIEN=$ORDER(^DGPM("B",START,BGPIEN))
IF BGPIEN=""
QUIT
Begin DoDot:2
+8 ;Only include admissions
IF $PIECE($GET(^DGPM(BGPIEN,0)),U,2)'=1
QUIT
+9 SET DFN=$PIECE($GET(^DGPM(BGPIEN,0)),U,3)
+10 SET BGPAGEE=$$AGE^AUPNPAT(DFN,BGPEDATE)
+11 IF DFN=""
QUIT
+12 SET BGPACTUP=$$ACTUPAP^BGPMUEHD(DFN,BGPBDATE,BGPEDATE,BGPBEN)
+13 IF 'BGPACTUP
IF '$GET(BGPXPXPX)
IF '$GET(BGPIISO)
QUIT
+14 ;Get the visit
SET BGPVST=$PIECE($GET(^DGPM(BGPIEN,0)),U,27)
+15 IF BGPVST=""
QUIT
+16 ;Don't use if pt is still an inpt
SET BGPDIS=$PIECE($GET(^DGPM(BGPIEN,0)),U,17)
+17 IF BGPDIS=""
QUIT
+18 ;Check for a diagnosis of stroke
+19 SET STROKE=0
SET EXC=0
SET NUM=0
+20 SET BGPISDX=$$VSTPOVA^BGPMUUT3(DFN,BGPVST,"BGPMU ISCHEMIC STROKE DX")
+21 ;S BGPIPROB=$$PLTAX^BGPMUUT1(DFN,"BGPMU ISCHEMIC STROKE DX","A")
+22 ;Pt must have both a POV of stoke and it must be an active problem
+23 ;I +BGPISDX&(+BGPIPROB) S STROKE=1
+24 IF +BGPISDX
SET STROKE=1
+25 IF +STROKE
Begin DoDot:3
+26 ;Get the admit time & discharge times
+27 SET BGPADMIT=$PIECE($GET(^DGPM(BGPIEN,0)),U,1)
+28 SET BGPDD=$PIECE($GET(^DGPM(BGPDIS,0)),U,1)
+29 ;See if there is an ER visit prior to admission
+30 SET BGPER=$$ER(DFN,BGPADMIT)
+31 SET EXC=$$EXCLUDE(DFN,BGPIEN,BGPVST,BGPDIS)
+32 ;Find the date/time of last known well
+33 SET LKW=$$WELL(DFN,BGPER,BGPADMIT,BGPDD)
+34 IF LKW=0
SET EXC="1^LKW"
+35 ;If no exclusions see if they had tPA given in correct time frame
+36 IF EXC=""
SET NUM=$$NUMER(DFN,LKW)
+37 ;Now add it all up
+38 DO TOTAL(BGPIEN)
End DoDot:3
End DoDot:2
End DoDot:1
+39 QUIT
TOTAL(BGPIEN) ;add up the totals
+1 NEW PTCNT,EXCCT,DENCT,NUMCT,TOTALS,DATE,NOTCT
+2 SET TOTALS=$GET(^TMP("BGPMU0437",$JOB,BGPMUTF,"TOT"))
+3 SET DENCT=+$GET(^TMP("BGPMU0437",$JOB,BGPMUTF,"DEN"))
+4 SET NUMCT=+$GET(^TMP("BGPMU0437",$JOB,BGPMUTF,"NUM"))
+5 SET EXCCT=+$GET(^TMP("BGPMU0437",$JOB,BGPMUTF,"EXC"))
+6 SET NOTCT=+$GET(^TMP("BGPMU0437",$JOB,BGPMUTF,"NOT"))
+7 SET PTCNT=TOTALS
+8 SET PTCNT=PTCNT+1
+9 SET DATE=$$DATE^BGPMUUTL($PIECE($GET(^DGPM(BGPIEN,0)),U,1))
+10 SET DENCT=DENCT+1
SET ^TMP("BGPMU0437",$JOB,BGPMUTF,"DEN")=DENCT
+11 IF EXC'=""
Begin DoDot:1
+12 SET EXCCT=EXCCT+1
SET ^TMP("BGPMU0437",$JOB,BGPMUTF,"EXC")=EXCCT
+13 IF BGPMUTF="C"
SET ^TMP("BGPMU0437",$JOB,"PAT",BGPMUTF,"EXC",PTCNT)=DFN_U_DATE_U_$PIECE(EXC,U,2)
End DoDot:1
+14 IF EXC=""
Begin DoDot:1
+15 IF +NUM=1
Begin DoDot:2
+16 SET NUMCT=NUMCT+1
SET ^TMP("BGPMU0437",$JOB,BGPMUTF,"NUM")=NUMCT
+17 SET ^TMP("BGPMU0437",$JOB,"PAT",BGPMUTF,"NUM",PTCNT)=DFN_U_DATE_U_$PIECE(NUM,U,3)_U_$PIECE(NUM,U,2)
End DoDot:2
+18 IF +NUM=0
Begin DoDot:2
+19 SET ^TMP("BGPMU0437",$JOB,"PAT",BGPMUTF,"NOT",PTCNT)=DFN_U_DATE_U_$PIECE(NUM,U,3)_U_$PIECE(NUM,U,2)
+20 SET NOTCT=NOTCT+1
SET ^TMP("BGPMU0437",$JOB,BGPMUTF,"NOT")=NOTCT
End DoDot:2
End DoDot:1
+21 SET ^TMP("BGPMU0437",$JOB,BGPMUTF,"TOT")=PTCNT
+22 SET BGPICARE("MU.STK.0437.1",BGPMUTF,DFN)=1_U_+$GET(NUM)_U_+EXC_U_DATE_";"_$PIECE($GET(NUM),U,3)_";"_$PIECE(EXC,U,2)
+23 QUIT
EXCLUDE(DFN,BGPIEN,BGPVST,BGPDIS) ;See if there are exclusions
+1 NEW REASON,BGPLOS,BGPHOS,BGPCLIN,BGPECI,DTYPE1,DTYPE2,BGPALL,BGPREF,NOXTHROM,NODTHROM,NOPTHROM
+2 SET REASON=""
+3 IF BGPAGEE<18
SET REASON="1^AGE"
QUIT REASON
+4 ;Check for LOS
+5 SET BGPLOS=$$LOS^BGPMUH08(BGPIEN,BGPDIS)
+6 IF BGPLOS>120
SET REASON="1^LOS"
QUIT REASON
+7 ;Check for clinical trial
+8 SET BGPCLIN=$$TRIAL^BGPMUH08(DFN,BGPVST)
+9 IF +BGPCLIN
SET REASON=BGPCLIN
QUIT REASON
+10 ;Check for elective carotid intervention procedure
+11 SET BGPECI=$$ELECTIVE^BGPMUH08(DFN,BGPVST,BGPIEN)
+12 IF +BGPECI
SET REASON=BGPECI
QUIT REASON
+13 ;Check for refusals
+14 SET BGPREF=$$REF(DFN,BGPVST,BGPDIS)
+15 IF +BGPREF
SET REASON=BGPREF
QUIT REASON
+16 ;Check for reasons not initiated
+17 ; Check for CPT procedure within the past 180 days
+18 SET BGPDISDT=$PIECE($PIECE($GET(^DGPM(BGPDIS,0)),U,1),".",1)
+19 SET BGPDD180=$$FMADD^XLFDT(BGPDISDT,-180)
+20 SET NOXTHROM=$$CPT^BGPMUUT1(DFN,BGPDD180,BGPDISDT,"BGPMU WARFARIN THERAPY CPT")
+21 IF +NOXTHROM
SET REASON=NOXTHROM
QUIT REASON
+22 ; Check for POV within the past 180 days
+23 SET NODTHROM=$$LASTDX^BGPMUUT2(DFN,BGPDD180,BGPDISDT,"BGPMU WARFARIN THERAPY ICD")
+24 IF +NODTHROM
SET REASON=NODTHROM
QUIT REASON
+25 ; Check for Problem doc'd within the past 180 days
+26 SET NOPTHROM=$$PLTAX^BGPMUUT1(DFN,"BGPMU WARFARIN THERAPY ICD","C")
+27 IF +NOPTHROM
Begin DoDot:1
+28 SET PDATE=$PIECE(NOPTHROM,U,3)
+29 IF PDATE>BGPDD180
SET REASON=1_U_$PIECE(NOPTHROM,U,2)_" "_$$DATE^BGPMUUTL($PIECE(NOPTHROM,U,3))
End DoDot:1
+30 QUIT REASON
REF(DFN,BGPVST,BGPDIS) ;Find refuals for this medication
+1 NEW ENDDT,X1,X2,X,MED,BGPEVT,DISDT
+2 SET MED=0
+3 SET BGPEVT=$PIECE($GET(^AUPNVSIT(BGPVST,0)),U,1)
+4 SET DISDT=$PIECE($GET(^DGPM(BGPDIS,0)),U,1)
+5 SET ENDDT=$$FMADD^XLFDT(DISDT,+1)
+6 SET TAX="BGPMU TPA NDC CODES"
+7 SET MED=$$MEDREF^BGPMUUT2(DFN,BGPEVT,ENDDT,TAX)
+8 QUIT MED
NUMER(DFN,LKW) ;Check to see if pt is in the numerator
+1 NEW TAX,MEDDTE,ENDDT,TPA,MEDIEN,STATUS,DRUG,DISPENSE
+2 SET TPA=0
+3 ;Start time is last known well
SET MEDDTE=$PIECE(LKW,U,2)
+4 ;Don't search more than 24hrs
SET ENDDT=$$FMADD^XLFDT(MEDDTE,+1)
+5 FOR
SET MEDDTE=$ORDER(^PSB(53.79,"AADT",DFN,MEDDTE))
IF '+MEDDTE!(MEDDTE>ENDDT)!(+TPA)
QUIT
Begin DoDot:1
+6 SET MEDIEN=""
FOR
SET MEDIEN=$ORDER(^PSB(53.79,"AADT",DFN,MEDDTE,MEDIEN))
IF '+MEDIEN!(+TPA)
QUIT
Begin DoDot:2
+7 SET STATUS=$PIECE($GET(^PSB(53.79,MEDIEN,0)),U,9)
+8 ;Drug given
IF STATUS="G"!(STATUS="I")!(STATUS="C")
Begin DoDot:3
+9 ;Lapsed time in seconds
SET TIME=$$FMDIFF^XLFDT(MEDDTE,$PIECE(LKW,U,2),1)
+10 IF (TIME\60)<180
Begin DoDot:4
+11 SET DISPENSE=0
FOR
SET DISPENSE=$ORDER(^PSB(53.79,MEDIEN,.5,DISPENSE))
IF '+DISPENSE!(+TPA)
QUIT
Begin DoDot:5
+12 SET DRUG=$GET(^PSB(53.79,MEDIEN,.5,DISPENSE,0))
+13 SET DRUG=$PIECE(DRUG,U,1)
+14 SET TAX="BGPMU TPA NDC CODES"
+15 SET TPA=$$NDC^BGPMUUT4(DRUG,TAX)
+16 IF +TPA
SET $PIECE(TPA,U,3)=BGPDD
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+17 QUIT TPA
ER(DFN,BGPADMIT,BGPVST) ;Find ER admit time since TPA is often given in the ER
+1 NEW VST,IEN,FOUND,ERDTE,NEW
+2 SET FOUND=0
SET VST=0
+3 SET IEN=""
FOR
SET IEN=$ORDER(^AMERVSIT("AC",DFN,IEN),-1)
IF IEN=""!(+FOUND)
QUIT
Begin DoDot:1
+4 SET ERDTE=$PIECE($GET(^AMERVSIT(IEN,0)),U,1)
+5 SET NEW=$$FMADD^XLFDT(BGPADMIT,-1)
+6 IF ERDTE>NEW&(ERDTE<BGPADMIT)
SET FOUND=1
SET VST=ERDTE
End DoDot:1
+7 QUIT VST
WELL(DFN,BGPER,BGPADMIT,BGPDD) ;Find is pt has a last known well
+1 NEW IEN,MSR,MTYP,LKW,CNT,TIME,X1,INVD
+2 SET LKW=""
SET CNT=0
+3 SET MTYP=""
SET MTYP=$ORDER(^AUTTMSR("B","LKW",MTYP))
+4 IF MTYP=""
QUIT 0
+5 SET INVD=""
FOR
SET INVD=$ORDER(^AUPNVMSR("AE",DFN,MTYP,INVD))
IF INVD=""!(+CNT)
QUIT
Begin DoDot:1
+6 SET MSR=""
FOR
SET MSR=$ORDER(^AUPNVMSR("AE",DFN,MTYP,INVD,MSR))
IF MSR=""!(+CNT)
QUIT
Begin DoDot:2
+7 IF $PIECE($GET(^AUPNVMSR(MSR,0)),U,1)=MTYP
Begin DoDot:3
+8 SET TIME=$PIECE($GET(^AUPNVMSR(MSR,12)),U,1)
+9 IF TIME>BGPDD
QUIT
+10 SET X1=$$FMDIFF^XLFDT(BGPER,TIME,2)
IF (X1\60)<120
SET CNT=1_U_TIME_"^ER"
QUIT
+11 SET X1=$$FMDIFF^XLFDT(BGPADMIT,TIME,2)
IF (X1\60)<120
SET CNT=1_U_TIME_"^AD"
QUIT
+12 IF TIME>BGPADMIT
SET CNT=1_U_TIME_"^IN"
End DoDot:3
End DoDot:2
End DoDot:1
+13 QUIT CNT
