source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRCAPAM2.m@ 861

LRCAPAM2 ;DALISC/FHS/JBM - PHASE 2 OF LMIP DATA COLLECTION 67.9 TO ^LAH(

 ;;5.2;LAB SERVICE;**105,201**;Sep 27, 1994

EN ;

 ;Screening data based on the ^(2) node for LMIP billable procedures.

 S LINE="PHASE 2 OF LMIP DATA COLLECTION" W !?(IOM-$L(LINE))\2,LINE,!

 S LINE="This step will create a temporary global from which" W !?(IOM-$L(LINE))\2,LINE,!

 S LINE="a mail message will be created for transmission to" W !?(IOM-$L(LINE))\2,LINE,!

 S LINE="the National Data Base." W !?(IOM-$L(LINE))\2,LINE,!

CHK I $O(^LAH("LABWL",0)) W !!?10,"THERE IS PREVIOUS DATA STORED IN ^LAH(LABWL, FILE",!!?5,"DO YOU WISH TO PURGE THIS DATA? ",! S %=2 D YN^DICN G CHK:%=0,STOP:%=-1 K:%=1 ^LAH("LABWL")

DT K %,%DT,LINE S $P(BLK," ",50)="",%DT(0)="-NOW",%DT="AEXP",%DT("A")="Begin with what Date : " D ^%DT G STOP:Y<1 S LRSDT=Y-.0001

 S Y2=0,%DT("A")="End with what date: ",%DT("B")=$$FMTE^XLFDT(Y,"1D") D ^%DT G STOP:Y<1 S LREDT=Y

DQ I LREDT<LRSDT S LREDT=LRSDT,LRSDT=Y

 S:'$D(^LAH("LABWL",0)) ^(0)=0 S LRML=0

PRI S LRPRI=0 F  S LRPRI=+$O(^LRO(67.9,LRPRI)) Q:'LRPRI  S LRHD1=$G(^(LRPRI,0)) I $L(LRHD1),$O(^(1,0)),$G(^DIC(4,+LRHD1,99)) S $P(LRHD1,U)=$P(^(99),U) D

 .S LRHD1="$"_$E(LRHD1,1,30)

 .S LRSITE=0 F  S LRSITE=+$O(^LRO(67.9,LRPRI,1,LRSITE)) Q:'LRSITE  S LRHD2=$G(^(LRSITE,0)) I $L(LRHD2),$O(^(1,0)),$G(^DIC(4,+LRHD2,99)) S $P(LRHD2,U)=$P(^(99),U) D

 ..S LRHD2="$$"_$E(LRHD2,1,30)

 ..S LRDAT=($E(LRSDT,1,5)_"00"-.9999) F  S LRDAT=+$O(^LRO(67.9,LRPRI,1,LRSITE,1,"B",LRDAT)) Q:'LRDAT!($E(LRDAT,1,5)>$E(LREDT,1,5))  S LRDATE=$O(^(LRDAT,0)) I LRDATE D

 ...S LRDATEP=$P($G(^LRO(67.9,LRPRI,1,LRSITE,1,LRDATE,0)),U) I LRDATEP S ^LAH("LABWL",0)=1+^LAH("LABWL",0),CNT=^(0),^(CNT)=LRHD1_LRHD2_"$$$"_LRDATEP D

 ....W !,$$FMTE^XLFDT(LRDAT,"1D") S LRCC=0

 ....F  S LRCC=+$O(^LRO(67.9,LRPRI,1,LRSITE,1,LRDATE,1,LRCC)) Q:'LRCC  D:$G(^(LRCC,2))

 .....S LRCCN=$G(^LRO(67.9,LRPRI,1,LRSITE,1,LRDATE,1,LRCC,0))

 .....I LRCCN S $P(LRCCN,U,9)=$S($E($P(LRCCN,U,9))="+":$E($P(LRCCN,U,9),2,50),1:$E($P(LRCCN,U,9),1,50)) D

 ......K LRSECT S CNT=CNT+1,LRNCCN1=$P(LRCCN,U),LRDA=+$O(^LAM("C",LRNCCN1_" ",0))

 ......Q:'LRDA

 ......S LRSECT=$E($P($G(^LAB(64.21,+$P($G(^LAM(LRDA,0)),U,15),0)),U,2),1,3) S:'$L(LRSECT) LRSECT="NAS"

 ......S LRNCCN2=$E(($P(LRNCCN1,".",2)_"00000"),1,5) S:$L($P(LRNCCN1,"."))=5 LRNCCN1="0"_LRNCCN1

 ......S $P(LRCCN,U)=$P(LRNCCN1,".")_"."_LRNCCN2_$S($D(LRSECT):LRSECT,1:"NAS")

 ......S ^LAH("LABWL",CNT)="*"_$P(LRCCN,U,1,8)_U_$P(LRCCN,U,10)_U_$P(LRCCN,U,11)_U_$P(LRCCN,U,12)

 ......S CNT=CNT+1,^LAH("LABWL",CNT)="\"_$E($$UP^XLFSTR($P(LRCCN,U,9)),1,50)

 ......D TREA

 ....S ^LAH("LABWL",0)=CNT

 Q

TREA ;

 S LRTRE=0,STR="-" F  S LRTRE=+$O(^LRO(67.9,LRPRI,1,LRSITE,1,LRDATE,1,LRCC,1,LRTRE)) Q:'LRTRE  S LRTRED=$G(^(LRTRE,0)) I $L(LRTRED) S LRTRED=$P(LRTRED,U,1,2) D:($L(LRTRED)+$L(STR))>79 LONG S STR=STR_"|"_LRTRED

 I $L(STR)>1 S CNT=CNT+1,^LAH("LABWL",CNT)=STR,^(0)=CNT

 Q

LONG ;

 S CNT=CNT+1,^LAH("LABWL",CNT)=STR,STR="-"

 Q

STOP ;

 K %DT,BLK,CNT,LRCC,LRCCN,LRNCCN1,LRNCCN2,LRDA,LRDATE,LRDATEP,LREDT,LRHD1

 K LRDAT,LRHD2,LRML,LRPRI,LRSDT,LRSITE,LRTRE,LRTRED,STR,Y,Y2

 Q