LRCAPBV1 ;DALOI/FHS - PROCESS VBEC PCE WORKLOAD API ; 4/3/07 3:31am
;;5.2;LAB SERVICE;**325,401**;Sep 27,1994;Build 7
;Reference to $$FIND1^DIC supported by IA #2051
;Reference to FILE^DID supported by IA #2052
;Reference to FILE^DIE supported by IA #2053
;Reference to UPDATE^DIE supported by IA #2053
;Reference to GETS^DIQ supported by IA #2056
;Reference to $$GET^XUA4A72 supported by IA #1625
Q
EN(LREDT,LRDUZ,LRTSTP,LRDSSLOC,LRDSSID,LRNINS,DFN,LRPRO,LRCNT) ;Call LRCAPPH1 to send PCE workload
;LREDT = Encounter Date
;LRDUZ = User
;LRTSTP = ^LAB(60 IEN
;LRDSSLOC = DSS LOCATION
;LRDSSID = DSS ID
;LRNINIS = Instution
;DFN = Patient
;LRPRO = Provider
;LRCNT = set negative if the test is cancelled.
I LRCNT<1 S LRNP=1
K ^TMP("LRPXAPI",$J),LROK,LRXTST
K LRICPT,CPT,LRCEX,LRREL,LRINA,LRNOP,EDATE
S (LROA,LRCEX)=0,ERR=699,EDATE=$P(LREDT,".")
S LRESCPT=0,LRTST=LRTSTP
I $$GET^XUA4A72(LRPRO)<1 D
. S LRPRO=LRDPRO
EN6 D EN6^LRCAPPH1
I $G(LRNOP) D Q
. S ERR="PCE+"_LRNOP D EUPDATE^LRCAPBV
S ERR=0
I $D(^LRO(69,LRCDT,1,LRSN,0)) S ^("PCE")=""
I $D(^TMP("LRPXAPI",$J,"PROCEDURE")) D SEND^LRCAPPH1
K LRFDA(3)
I $G(LROK)>0 D Q
. S LRFDA(3,6002.01,LRIEN_",",99)=LRVSITN
. D FILE
PCEERR ;PCE error logging
Q:'$G(LROK)
S LRFDA(3,6002.01,LRIEN_",",21)="PCE "_LROK_" Error"
S LRFDA(3,6002.01,LRIEN_",",5)="E"
FILE ;
D FILE^DIE("S","LRFDA(3)","ERR")
Q
NLT(LRP,LRSUF) ;Lookup or create new NLT code
N ANS,FDA,LRFDA,FLD,ERR,LRPN,LRLRT,LRLRTN
I '$D(^LAM(+$G(LRP),0))#2 S ERR="No NLT Code" Q 0
I '$G(LRSUF) Q +$G(LRP)
D GETS^DIQ(64,LRP_",",".01:16","IEN","ANS","ERR")
S LRSUF=$$FIND1^DIC(64.2,"","O","."_LRSUF_" ","C","","ERR") ;RLM 11-20-09
D GETS^DIQ(64.2,LRSUF_",",".01;1","IEN","ANS","ERR")
S LRLRT=$G(ANS(64,LRP_",",.01,"I"))_"~"_$G(ANS(64.2,LRSUF_",",.01,"I"))
S LRLRTN=$P($G(ANS(64,LRP_",",1,"I")),".")_$G(ANS(64.2,LRSUF_",",1,"I"))
NLT1 ;Lookup
S LRPN=$$FIND1^DIC(64,"","O",LRLRTN_" ","C","","ERR")
I LRPN>0 Q LRPN
S FLD="" F S FLD=$O(ANS(64,LRP_",",FLD)) Q:FLD="" D
. S LRFDA(1,64,"+1,",FLD)=$G(ANS(64,LRP_",",FLD,"I"))
S LRFDA(1,64,"+1,",.01)=LRLRT
S LRFDA(1,64,"+1,",1)=LRLRTN
D UPDATE^DIE("S","LRFDA(1)","FDA","ERR")
S LRPN=FDA(1)
Q LRPN
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRCAPBV1 2258 printed Apr 09, 2024@21:08:10 Page 2
LRCAPBV1 ;DALOI/FHS - PROCESS VBEC PCE WORKLOAD API ; 4/3/07 3:31am
+1 ;;5.2;LAB SERVICE;**325,401**;Sep 27,1994;Build 7
+2 ;Reference to $$FIND1^DIC supported by IA #2051
+3 ;Reference to FILE^DID supported by IA #2052
+4 ;Reference to FILE^DIE supported by IA #2053
+5 ;Reference to UPDATE^DIE supported by IA #2053
+6 ;Reference to GETS^DIQ supported by IA #2056
+7 ;Reference to $$GET^XUA4A72 supported by IA #1625
+8 QUIT
EN(LREDT,LRDUZ,LRTSTP,LRDSSLOC,LRDSSID,LRNINS,DFN,LRPRO,LRCNT) ;Call LRCAPPH1 to send PCE workload
+1 ;LREDT = Encounter Date
+2 ;LRDUZ = User
+3 ;LRTSTP = ^LAB(60 IEN
+4 ;LRDSSLOC = DSS LOCATION
+5 ;LRDSSID = DSS ID
+6 ;LRNINIS = Instution
+7 ;DFN = Patient
+8 ;LRPRO = Provider
+9 ;LRCNT = set negative if the test is cancelled.
+10 IF LRCNT<1
SET LRNP=1
+11 KILL ^TMP("LRPXAPI",$JOB),LROK,LRXTST
+12 KILL LRICPT,CPT,LRCEX,LRREL,LRINA,LRNOP,EDATE
+13 SET (LROA,LRCEX)=0
SET ERR=699
SET EDATE=$PIECE(LREDT,".")
+14 SET LRESCPT=0
SET LRTST=LRTSTP
+15 IF $$GET^XUA4A72(LRPRO)<1
Begin DoDot:1
+16 SET LRPRO=LRDPRO
End DoDot:1
EN6 DO EN6^LRCAPPH1
+1 IF $GET(LRNOP)
Begin DoDot:1
+2 SET ERR="PCE+"_LRNOP
DO EUPDATE^LRCAPBV
End DoDot:1
QUIT
+3 SET ERR=0
+4 IF $DATA(^LRO(69,LRCDT,1,LRSN,0))
SET ^("PCE")=""
+5 IF $DATA(^TMP("LRPXAPI",$JOB,"PROCEDURE"))
DO SEND^LRCAPPH1
+6 KILL LRFDA(3)
+7 IF $GET(LROK)>0
Begin DoDot:1
+8 SET LRFDA(3,6002.01,LRIEN_",",99)=LRVSITN
+9 DO FILE
End DoDot:1
QUIT
PCEERR ;PCE error logging
+1 if '$GET(LROK)
QUIT
+2 SET LRFDA(3,6002.01,LRIEN_",",21)="PCE "_LROK_" Error"
+3 SET LRFDA(3,6002.01,LRIEN_",",5)="E"
FILE ;
+1 DO FILE^DIE("S","LRFDA(3)","ERR")
+2 QUIT
NLT(LRP,LRSUF) ;Lookup or create new NLT code
+1 NEW ANS,FDA,LRFDA,FLD,ERR,LRPN,LRLRT,LRLRTN
+2 IF '$DATA(^LAM(+$GET(LRP),0))#2
SET ERR="No NLT Code"
QUIT 0
+3 IF '$GET(LRSUF)
QUIT +$GET(LRP)
+4 DO GETS^DIQ(64,LRP_",",".01:16","IEN","ANS","ERR")
+5 ;RLM 11-20-09
SET LRSUF=$$FIND1^DIC(64.2,"","O","."_LRSUF_" ","C","","ERR")
+6 DO GETS^DIQ(64.2,LRSUF_",",".01;1","IEN","ANS","ERR")
+7 SET LRLRT=$GET(ANS(64,LRP_",",.01,"I"))_"~"_$GET(ANS(64.2,LRSUF_",",.01,"I"))
+8 SET LRLRTN=$PIECE($GET(ANS(64,LRP_",",1,"I")),".")_$GET(ANS(64.2,LRSUF_",",1,"I"))
NLT1 ;Lookup
+1 SET LRPN=$$FIND1^DIC(64,"","O",LRLRTN_" ","C","","ERR")
+2 IF LRPN>0
QUIT LRPN
+3 SET FLD=""
FOR
SET FLD=$ORDER(ANS(64,LRP_",",FLD))
if FLD=""
QUIT
Begin DoDot:1
+4 SET LRFDA(1,64,"+1,",FLD)=$GET(ANS(64,LRP_",",FLD,"I"))
End DoDot:1
+5 SET LRFDA(1,64,"+1,",.01)=LRLRT
+6 SET LRFDA(1,64,"+1,",1)=LRLRTN
+7 DO UPDATE^DIE("S","LRFDA(1)","FDA","ERR")
+8 SET LRPN=FDA(1)
+9 QUIT LRPN
+10 QUIT
