BLRTNCON.m

BLRTNCON ; IHS/MSC/MKK - IHS Lab to PCC Create/Edit Transactions (Continued) ; 17-Dec-2015 15:37 ; MKK

 ;;5.2;IHS LABORATORY;**1038**;NOV 01, 1997;Build 6

 ;

 ; Code moved from BLRTN to here because BLRTN became too large.

 ;

EEP ; EP - Ersatz EP

 D EEP^BLRGMENU

 Q

 ;

GETCPT ; EP

 Q:BLRODTM<$P($G(^BLRCPT(BLRXII,0)),U,3)

 S BLRFOUND=1,BLRCPTP=BLRXII

 S BLRCPTN=0 F BLRNN=1:1 S BLRCPTN=$O(^BLRCPT(BLRXII,11,BLRCPTN)) Q:'BLRCPTN  S BLRCPDAT=$G(^BLRCPT(BLRXII,11,BLRCPTN,0)),BLRCPCD=$P(BLRCPDAT,U),BLRCPCST=$P(BLRCPDAT,U,2),BLRCPRC=$P(BLRCPDAT,U,3),BLRCPACT=$P(BLRCPDAT,U,4) D

 .S (BLRCPTM,BLRCPTQ)=""

 .S BLRCPMN=0 F BLRNN1=1:1 S BLRCPMN=$O(^BLRCPT(BLRXII,11,BLRCPTN,1,BLRCPMN)) Q:'BLRCPMN  S:BLRNN1>1 BLRCPTM=BLRCPTM_"," S BLRCPTM=BLRCPTM_$G(^BLRCPT(BLRXII,11,BLRCPTN,1,BLRCPMN,0))

 .S BLRCPQN=0 F BLRNN1=1:1 S BLRCPQN=$O(^BLRCPT(BLRXII,11,BLRCPTN,2,BLRCPQN)) Q:'BLRCPQN  S:BLRNN1>1 BLRCPTQ=BLRCPTQ_"," S BLRCPTQ=BLRCPTQ_$G(^BLRCPT(BLRXII,11,BLRCPTN,2,BLRCPQN,0))

 .;

 .; Stores the CPT Code and not BLRCPCD.  BLRCPCD is the IEN into file 81.

 .S:BLRNN>1 BLRCPTS=BLRCPTS_";" S BLRCPTS=BLRCPTS_$$GET1^DIQ(81,BLRCPCD,.01)_"|"_BLRCPCST_"|"_BLRCPRC_"|"_BLRCPACT_"|"_BLRCPTM_"|"_BLRCPTQ

 ;

 K BLRCPCD,BLRCPCST,BLRCPRC,BLRCPACT,BLRCPTN,BLRCPDAT,BLRCPTM,BLRCPMN,BLRCPTQ,BLRCPQN,BLRNN,BLRNN1

 Q

BLRTNCON  ; IHS/MSC/MKK - IHS Lab to PCC Create/Edit Transactions (Continued) ; 17-Dec-2015 15:37 ; MKK

 +1       ;;5.2;IHS LABORATORY;**1038**;NOV 01, 1997;Build 6

 +2       ;

 +3       ; Code moved from BLRTN to here because BLRTN became too large.

 +4       ;

EEP       ; EP - Ersatz EP

 +1        DO EEP^BLRGMENU

 +2        QUIT 

 +3       ;

GETCPT    ; EP

 +1        IF BLRODTM<$PIECE($GET(^BLRCPT(BLRXII,0)),U,3)

               QUIT 

 +2        SET BLRFOUND=1

           SET BLRCPTP=BLRXII

 +3        SET BLRCPTN=0

           FOR BLRNN=1:1

               SET BLRCPTN=$ORDER(^BLRCPT(BLRXII,11,BLRCPTN))

               IF 'BLRCPTN

                   QUIT 

               SET BLRCPDAT=$GET(^BLRCPT(BLRXII,11,BLRCPTN,0))

               SET BLRCPCD=$PIECE(BLRCPDAT,U)

               SET BLRCPCST=$PIECE(BLRCPDAT,U,2)

               SET BLRCPRC=$PIECE(BLRCPDAT,U,3)

               SET BLRCPACT=$PIECE(BLRCPDAT,U,4)

               Begin DoDot:1

 +4                SET (BLRCPTM,BLRCPTQ)=""

 +5                SET BLRCPMN=0

                   FOR BLRNN1=1:1

                       SET BLRCPMN=$ORDER(^BLRCPT(BLRXII,11,BLRCPTN,1,BLRCPMN))

                       IF 'BLRCPMN

                           QUIT 

                       IF BLRNN1>1

                           SET BLRCPTM=BLRCPTM_","

                       SET BLRCPTM=BLRCPTM_$GET(^BLRCPT(BLRXII,11,BLRCPTN,1,BLRCPMN,0))

 +6                SET BLRCPQN=0

                   FOR BLRNN1=1:1

                       SET BLRCPQN=$ORDER(^BLRCPT(BLRXII,11,BLRCPTN,2,BLRCPQN))

                       IF 'BLRCPQN

                           QUIT 

                       IF BLRNN1>1

                           SET BLRCPTQ=BLRCPTQ_","

                       SET BLRCPTQ=BLRCPTQ_$GET(^BLRCPT(BLRXII,11,BLRCPTN,2,BLRCPQN,0))

 +7       ;

 +8       ; Stores the CPT Code and not BLRCPCD.  BLRCPCD is the IEN into file 81.

 +9                IF BLRNN>1

                       SET BLRCPTS=BLRCPTS_";"

                   SET BLRCPTS=BLRCPTS_$$GET1^DIQ(81,BLRCPCD,.01)_"|"_BLRCPCST_"|"_BLRCPRC_"|"_BLRCPACT_"|"_BLRCPTM_"|"_BLRCPTQ

               End DoDot:1

 +10      ;

 +11       KILL BLRCPCD,BLRCPCST,BLRCPRC,BLRCPACT,BLRCPTN,BLRCPDAT,BLRCPTM,BLRCPMN,BLRCPTQ,BLRCPQN,BLRNN,BLRNN1

 +12       QUIT