45 lines
3.0 KiB
Mathematica
45 lines
3.0 KiB
Mathematica
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
|