| [613] | 1 | LRCAPAM2 ;DALISC/FHS/JBM - PHASE 2 OF LMIP DATA COLLECTION 67.9 TO ^LAH(
|
|---|
| 2 | ;;5.2;LAB SERVICE;**105,201**;Sep 27, 1994
|
|---|
| 3 | EN ;
|
|---|
| 4 | ;Screening data based on the ^(2) node for LMIP billable procedures.
|
|---|
| 5 | S LINE="PHASE 2 OF LMIP DATA COLLECTION" W !?(IOM-$L(LINE))\2,LINE,!
|
|---|
| 6 | S LINE="This step will create a temporary global from which" W !?(IOM-$L(LINE))\2,LINE,!
|
|---|
| 7 | S LINE="a mail message will be created for transmission to" W !?(IOM-$L(LINE))\2,LINE,!
|
|---|
| 8 | S LINE="the National Data Base." W !?(IOM-$L(LINE))\2,LINE,!
|
|---|
| 9 | 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")
|
|---|
| 10 | 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
|
|---|
| 11 | S Y2=0,%DT("A")="End with what date: ",%DT("B")=$$FMTE^XLFDT(Y,"1D") D ^%DT G STOP:Y<1 S LREDT=Y
|
|---|
| 12 | DQ I LREDT<LRSDT S LREDT=LRSDT,LRSDT=Y
|
|---|
| 13 | S:'$D(^LAH("LABWL",0)) ^(0)=0 S LRML=0
|
|---|
| 14 | 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
|
|---|
| 15 | .S LRHD1="$"_$E(LRHD1,1,30)
|
|---|
| 16 | .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
|
|---|
| 17 | ..S LRHD2="$$"_$E(LRHD2,1,30)
|
|---|
| 18 | ..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
|
|---|
| 19 | ...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
|
|---|
| 20 | ....W !,$$FMTE^XLFDT(LRDAT,"1D") S LRCC=0
|
|---|
| 21 | ....F S LRCC=+$O(^LRO(67.9,LRPRI,1,LRSITE,1,LRDATE,1,LRCC)) Q:'LRCC D:$G(^(LRCC,2))
|
|---|
| 22 | .....S LRCCN=$G(^LRO(67.9,LRPRI,1,LRSITE,1,LRDATE,1,LRCC,0))
|
|---|
| 23 | .....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
|
|---|
| 24 | ......K LRSECT S CNT=CNT+1,LRNCCN1=$P(LRCCN,U),LRDA=+$O(^LAM("C",LRNCCN1_" ",0))
|
|---|
| 25 | ......Q:'LRDA
|
|---|
| 26 | ......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"
|
|---|
| 27 | ......S LRNCCN2=$E(($P(LRNCCN1,".",2)_"00000"),1,5) S:$L($P(LRNCCN1,"."))=5 LRNCCN1="0"_LRNCCN1
|
|---|
| 28 | ......S $P(LRCCN,U)=$P(LRNCCN1,".")_"."_LRNCCN2_$S($D(LRSECT):LRSECT,1:"NAS")
|
|---|
| 29 | ......S ^LAH("LABWL",CNT)="*"_$P(LRCCN,U,1,8)_U_$P(LRCCN,U,10)_U_$P(LRCCN,U,11)_U_$P(LRCCN,U,12)
|
|---|
| 30 | ......S CNT=CNT+1,^LAH("LABWL",CNT)="\"_$E($$UP^XLFSTR($P(LRCCN,U,9)),1,50)
|
|---|
| 31 | ......D TREA
|
|---|
| 32 | ....S ^LAH("LABWL",0)=CNT
|
|---|
| 33 | Q
|
|---|
| 34 | TREA ;
|
|---|
| 35 | 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
|
|---|
| 36 | I $L(STR)>1 S CNT=CNT+1,^LAH("LABWL",CNT)=STR,^(0)=CNT
|
|---|
| 37 | Q
|
|---|
| 38 | LONG ;
|
|---|
| 39 | S CNT=CNT+1,^LAH("LABWL",CNT)=STR,STR="-"
|
|---|
| 40 | Q
|
|---|
| 41 | STOP ;
|
|---|
| 42 | K %DT,BLK,CNT,LRCC,LRCCN,LRNCCN1,LRNCCN2,LRDA,LRDATE,LRDATEP,LREDT,LRHD1
|
|---|
| 43 | K LRDAT,LRHD2,LRML,LRPRI,LRSDT,LRSITE,LRTRE,LRTRED,STR,Y,Y2
|
|---|
| 44 | Q
|
|---|
