LRCAPBV1.m

LRCAPBV1 ;VA/DALOI/FHS - PROCESS VBEC PCE WORKLOAD API ; 22-Oct-2013 09:22 ; MKK

 ;;5.2;LAB SERVICE;**325,1031,401,1033**;NOV 1, 1997

 ;

 ;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")

 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

LRCAPBV1  ;VA/DALOI/FHS - PROCESS VBEC PCE WORKLOAD API ; 22-Oct-2013 09:22 ; MKK

 +1       ;;5.2;LAB SERVICE;**325,1031,401,1033**;NOV 1, 1997

 +2       ;

 +3       ;Reference to $$FIND1^DIC supported by IA #2051

 +4       ;Reference to FILE^DID supported by IA #2052

 +5       ;Reference to FILE^DIE supported by IA #2053

 +6       ;Reference to UPDATE^DIE supported by IA #2053

 +7       ;Reference to GETS^DIQ supported by IA #2056

 +8       ;Reference to $$GET^XUA4A72 supported by IA #1625

 +9        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        DO GETS^DIQ(64.2,LRSUF_",",".01;1","IEN","ANS","ERR")

 +6        SET LRLRT=$GET(ANS(64,LRP_",",.01,"I"))_"~"_$GET(ANS(64.2,LRSUF_",",.01,"I"))

 +7        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