Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LRBEPRPT

LRBEPRPT.m

Go to the documentation of this file. 
  1. LRBEPRPT ;VA/DALOI/FHS - PRINT CPT CODES FOR TESTS AND PANELS ;03/30/2005
  1.  ;;5.2;LAB SERVICE;**1031**;NOV 1, 1997
  1.  ;
  1.  ;;VA LR Patche(s): 291,359
  1.  ;
  1. BEBA ;Individual test CPT code look-up
  1.  K ^TMP("LR",$J,"VTO"),^TMP("LR",$J,"TMP")
  1.  S (LRBEPSY,LRBECPT)="" K DIR,X,Y,LRSTOP,LRPG
  1.  S LRBECDT=DT
  1.  S DIR(0)="PO^60:AQEZNM"
  1.  S DIR("S")="I $S('$L($P(^(0),U,3)):0,$P(^(0),U,3)=""N"":0,1:1)"
  1.  D ^DIR K DIR
  1.  I $G(Y)<1 D CLEAN Q
  1.  W @IOF
  1.  S LRBELOP=1,LRBEBY=Y,LRPRT=0
  1.  D LOOP
  1.  I $G(OUT) D  Q
  1.  . W !,+LRBEBY_"  = "_$P(^LAB(60,+LRBEBY,0),U)
  1.  . W !,"**********     ","Invalid data prevents display.",!
  1.  D:'$G(OUT) T1
  1.  D CLEAN
  1.  G BEBA
  1. LOOP ;
  1.  Q:$G(LRBEPSY)!($G(LRSTOP))
  1.  S:'$G(LRSPEC) LRSPEC=99999999 S:'$G(LRBECDT) LRBECDT=DT
  1.  K DIC,LRTEST,LRNAME,LRNLT,T1,LRY,LRBECPT,LRORD
  1.  K LRM,LRMX
  1.  K ^TMP("LR",$J,"VTO"),^TMP("LR",$J,"TMP")
  1.  S LRBECPT=""
  1.  S X=+LRBEBY_U_+LRBEBY,LRNLT=+LRBEBY,LRTEST(1,"P")=LRNLT_U_$$NLT^LRVER1(LRNLT)
  1.  S T1=1,LRTEST(T1)=+LRBEBY_U_^LAB(60,+LRBEBY,0)
  1.  S OUT=0,XX=$P(LRTEST(T1),U,6) D  Q:OUT
  1.  . I XX'="",+$P(XX,";",2)=0 S OUT=1 Q
  1.  . I XX'="" S LRBEY(+LRBEBY,+$P(XX,";",2))=""
  1.  . I $D(^LAB(60,+LRBEBY,2)) D
  1.  . . S I=0 F  S I=$O(^LAB(60,+LRBEBY,2,I)) Q:'I  D
  1.  . . . S K=$P(^LAB(60,+LRBEBY,2,I,0),U,1)
  1.  . . . S XX=$P(^LAB(60,K,0),U,5) I XX'="",+$P(XX,";",2)=0 S OUT=1 Q
  1.  . . . S LRBEY(+LRBEBY,+$P(XX,";",2))=""
  1.  K LRBECPT
  1.  S LRBETST=0,(LRPANEL,LRBEPYS)=""
  1.  S LRBETST=$O(LRBEY(LRBETST)) Q:LRBETST<1!($G(LRSTOP))  D
  1.  . Q:'$G(^LAB(60,LRBETST,12))
  1.  . Q:$L($P(^LAB(60,LRBETST,0),U,5))
  1.  . D PANEL^LRBEBA4
  1.  . I '$O(LRBECPT(LRBETST,0)) Q
  1.  . S LRPANEL="*"
  1.  . S LRBEPSY=1 D DISPLAY
  1.  . S (LRPANEL)=""
  1.  . W !
  1. PANEL ;Display panel test CPT
  1.  I $G(LRBEPSY) K LRBECPT Q
  1.  I $O(LRBECPT(0)) D  Q:$G(LRBELOP)!($G(LRSTOP))
  1.  . S LRBEPYS=1 D DISPLAY
  1.  Q:$S($G(LRBEPO):1,$G(LRBEPYS):1,1:0)
  1.  K LRBECPT
  1.  S LRTST=0,LRBETST=+LRBEBY
  1. NLT ;
  1.  S LRBECDT=DT D PANEL^LRBEBA4
  1.  Q:'$O(LRBECPT(0))
  1.  S LRI=0 F  S LRI=$O(LRBECPT(LRBETST,LRI)) Q:LRI<1!($G(LRSTOP))  D
  1.  . D LN Q:$G(LRSTOP)
  1.  . ;W !,"{"_LRBETST_"="_$P(^LAB(60,LRBETST,0),U)_"} "_$P($G(LRBEBY),U,2)
  1.  . ;W:$D(^LAB(61,LRSPEC,0))#2 "  (SPEC) = "_$E($P(^(0),U),1,30)
  1.  . S LRREQ=$S($P($G(^LAB(60,LRBETST,0)),U,17):"r ",1:" ")
  1.  . W !,LRBETST_" = "_LRREQ_$P($G(LRBEBY),U,2)_"  "  ;_$P(^LAB(60,LRBETST,0),U)
  1.  . W:$D(^LAB(61,LRSPEC,0))#2 " (SPEC) = "_$E($P(^(0),U),1,30)
  1.  . D WRT
  1.  Q
  1.  ;
  1. DISPLAY ;
  1.  Q:$G(LRSTOP)  K LRREQ
  1.  I $O(LRBECPT(0)),'$G(LRPRT) W ! S LRPRT=1
  1.  S LRBETST=0 F  S LRBETST=$O(LRBECPT(LRBETST)) Q:LRBETST<1!($G(LRSTOP))  D
  1.  . D LN Q:$G(LRSTOP)
  1.  . S LRREQ=$S($P($G(^LAB(60,LRBETST,0)),U,17):"r ",1:"")
  1.  . W !,LRBETST_" = "_LRREQ_$P(^LAB(60,LRBETST,0),U) I $D(^LAB(61,LRSPEC,0))#2 W " / "_$P(^(0),U)
  1.  . S LRI=0 F  S LRI=$O(LRBECPT(LRBETST,LRI)) Q:LRI<1  D WRT
  1.  Q
  1. WRT ;
  1.  D LN Q:$G(LRSTOP)
  1.  S LRPRT=1
  1.  S LRCPT=$O(LRBECPT(LRBETST,LRI,0)) Q:'LRCPT!($G(LRSTOP))  D
  1.  . D LN Q:$G(LRSTOP)
  1.  . S XCODE=$$CPT^ICPTCOD(LRCPT)
  1.  . W !?6,$P(XCODE,U,2)_"  "_$P(XCODE,U,3)_"  ["_LRBECPT(LRBETST,LRI,LRCPT)_"]"_$G(LRPANEL)
  1.  . K LRBECPT(LRBETST,LRI,LRCPT),XCODE
  1.  Q
  1.  ;
  1. LN ;Check line spacing
  1.  Q:$Y<(IOSL-4)!($G(LRSTOP))
  1.  I $E(IOST,1)="C" D  Q:LRSTOP
  1.  . N DIR S DIR(0)="E" D ^DIR S LRSTOP=$G(DIRUT)
  1. HDR ;Report header
  1.  W @IOF,! S LRPG=$G(LRPG)+1
  1.  W $$CJ^XLFSTR($G(LRHDR)_"         "_$$FMTE^XLFDT(DT,5)_"    Pg "_LRPG,IOM),!
  1.  Q
  1.  ;
  1. TEST ;List all test with CPT codes
  1.  ;logic follows the Billing Aware CPT logic Hierarchy
  1.   U IO
  1.   I '$G(LRPG) D HDR
  1.  S LRBELOP=1,LRBECDT=DT
  1.   S LRTN="^LAB(60,""B"")"
  1.  F  Q:$G(LRSTOP)  S LRTN=$Q(@LRTN) Q:$QS(LRTN,2)'="B"  D
  1.  . Q:$G(@LRTN)
  1.  . S LRSPEC=999999,LRBEBY=$QS(LRTN,4)
  1.  . Q:$S('$D(^LAB(60,LRBEBY,0))#2:1,'$L($P(^(0),U,3)):1,$P(^(0),U,3)="N":1,1:0)
  1.  . Q:$G(LRSTOP)
  1.  . S LRPRT=0,LRBEPSY=""
  1.  . S LRBEBY=LRBEBY_U_$P(^LAB(60,+LRBEBY,0),U)
  1.  . D LOOP
  1.  . Q:$G(OUT)
  1.  . Q:$G(LRSTOP)
  1.  . D T1
  1.  . K LRBEY,LRBEBY
  1.  . Q:$G(LRSTOP)
  1.  D CLEAN
  1.  Q
  1.  ;
  1. T1 ;
  1.  S LRSPEC=0 F  S LRSPEC=$O(^LAB(60,+LRBEBY,1,LRSPEC)) Q:LRSPEC<1!($G(LRSTOP))  D
  1.  . D LOOP
  1.  . K LRBECPT
  1.  Q:$G(OUT)
  1.  Q:$G(LRSTOP)
  1.   D ATOMIC
  1.  I $G(LRPRT) W !
  1.  K LRBEPSY
  1.  Q
  1.  ;
  1. ATOMIC ; Print Atomic test of panel
  1.  Q:'$O(^LAB(60,+LRBEBY,2,0))
  1.  W !,+LRBEBY_" = "_$P(^LAB(60,+LRBEBY,0),U),!,"**********"
  1.  N LRBEBSY,LRII,LRREQ
  1.  S LRBEBSY=+LRBEBY N LRII S LRII=0
  1.  F  S LRII=$O(^LAB(60,LRBEBSY,2,LRII)) Q:LRII<1!($G(LRSTOP))  D
  1.  . S LRBEBY=+$G(^LAB(60,LRBEBSY,2,LRII,0)) Q:'LRBEBY!($G(LRSTOP))  D
  1.  . . S LRREQ=$S($P($G(^LAB(60,LRBEBY,0)),U,17):"r",1:" ")
  1.  . . I $D(^LAB(60,LRBEBY,0)) S LRBEBY=LRREQ_"["_LRBEBY_"]  "_$P(^(0),U) D
  1.  . . . W ?15,LRBEBY,! D LN
  1.  Q
  1.  ;
  1. ASK ;Present user with a selection of options
  1.  K DIR,Y,LRSTOP,POP,ZTRTN,OUT,OPT,XX
  1.  K LRDEV,ZTDTH,ZTDESC,ZTIO,ZTSAVE
  1.  S OUT=0
  1.  S LRBECDT=DT
  1.  S DIR(0)="SO^1:Single Test Look-up;2:List Panels Only;3:List All Test"
  1.   D ^DIR K DIR
  1.  I Y<1 G CLEAN
  1.  S OPT=Y
  1.  I OPT=1 D  G ASK
  1.  . S LRHDR="*** Single Test code listing (CPT) ***"
  1.  . D BEBA
  1.  I OPT=2 D  G ASK
  1.  . S LRHDR="*** Panel Tests Only (CPT) ***",LRBEPO=1
  1.  . D DEV I $G(POP) D ^%ZISC Q
  1.  . I IO'=IO(0) D  Q
  1.  . . S ZTSAVE("LRBEPO")=""
  1.  . . S ZTRTN="TEST^LRBEPRPT"
  1.  . . D LOAD
  1.  . D TEST
  1.  I OPT=3 D  G ASK
  1.  . D DEV I $G(POP) D ^%ZISC Q
  1.  . S LRHDR="*** All Lab Tests (CPT) ***"
  1.  . I IO'=IO(0) D  Q
  1.  . . S ZTRTN="TEST^LRBEPRPT"
  1.  . . D LOAD
  1.  . D TEST
  1.  Q
  1.  ;
  1. DEV ;Select print device
  1.  N %ZIS,LRMSG,ZTDESC,ZTDTH,ZTIO,ZTSK,ZTSAVE
  1.  S %ZIS="NQ",%ZIS("A")=" Select Print Device: "
  1.  S (LRDEV,%ZIS("B"))="Home" D ^%ZIS
  1.  Q
  1. LOAD ;%ZTLOAD section
  1.  S ZTDTH=$H
  1.  S ZTDESC=$G(LRHDR)
  1.  S (LRDEV,ZTIO)=ION,ZTSAVE("LRHDR")=""
  1.  D ^%ZTLOAD W @IOF,!,$S($G(ZTSK):"Queued to device "_LRDEV,1:"Not Queued"),!
  1.  D ^%ZISC
  1.  D HOME^%ZIS
  1.  Q
  1.  ;
  1. CLEAN ;Clean-up
  1.  W:$D(ZTQUEUED) @IOF
  1.  K DIC,DIR,DIRUT,DTOUT,DUOUT
  1.  K LRBEBY,LRBECPT,LRBECDT,LRBEDT,LRBELOP,LRBEPYS,LRBEYS,LRBENLT,LRBETST,LRBEY,LRCFL
  1.  K LRCPT,LRI,LRIEN,LRM,LRMX,LRNAME,LRNLT,LRNX,LRORD,LRBEPO,LRPANEL,LRPRT
  1.  K LRSPEC,LRSTOP,LRSUB,LRTEST,LRTN,LRTST,LRXX,LRY,S2,T1,X,Y,YY
  1.  K LRHDR,LRDEV,LRPG,POP
  1.  K ^TMP("LR",$J,"VTO"),^TMP("LR",$J,"TMP")
  1.  D ^%ZISC
  1.  Q