LRCAPPNP ;DALOI/FHS - CPT NOT PERFORMED MESSAGES SENDER ; 5/1/99
;;5.2;LAB SERVICE;**263,264**;Sep 27, 1994
; Reference to ENCEVENT^PXKENC Supported by DBIA #1889-F
EN ;Called from LRCAPPH
L +^LRO("LRCAPPNP","AE"):1 Q:'$T
K LRNOP
S LRAEX="^LRO(69,""AE"",0)",LRNP=1
D NP^LRCAPPH G:$G(LRNOPX) END
S (LRCEX,LROA,LRSNX,LRAAX,LRCNT)=0
K ^LRO(69,"AE",0),^TMP("LRPXAPI",$J),LRXCPT
K ^TMP("PXKENC",$J)
LOOK ;
N LRNPPCE,LRNPX
F S LRAEX=$Q(@LRAEX) Q:$QS(LRAEX,2)'="AE" D I '$G(@LRAEX) K @LRAEX
. S LRCDT=$QS(LRAEX,4),LRSN=$QS(LRAEX,5),LRTST=$QS(LRAEX,6)
. Q:+$G(^LRO(69,LRCDT,1,LRSN,"PCE"))<1 S LRNPPCE=^("PCE")
. K ^TMP("PXKENC",$J),LRNPX
. D ENCEVENT^PXKENC(+LRNPPCE,1)
. I '$O(^TMP("PXKENC",$J,+LRNPPCE,"CPT",0)) D Q
. I LRNPPCE'[+LRNPPCE_"-CPT CANC-ENC DEL" D DELCAN^LRCAPPH1
. I $O(^TMP("PXKENC",$J,+LRNPPCE,"CPT",0)) D
. . N IEN
. . S IEN=0 F S IEN=$O(^TMP("PXKENC",$J,+LRNPPCE,"CPT",IEN)) Q:IEN<1 D
. . . I $G(^TMP("PXKENC",$J,+LRNPPCE,"CPT",IEN,0)) S LRNPX(+^(0))=$P(^(0),U,16)
. I LRSNX,LRSN'=LRSNX,$D(^TMP("LRPXAPI",$J,"PROCEDURE")) D
. . D SEND^LRCAPPH1 K ^TMP("LRPXAPI",$J) S LRCNT=1
. Q:'$O(LRNPX(0))
. S LRSNX=LRSN
. K LRNOPX D LOOK^LRCAPPH
. Q:'$G(LRNOPX)
. S LRNOP=0 D NP^LRCAPPH1
. I $G(LRNOP) S @LRAEX=LRNOP,LRNOP=0 Q
. Q:'$D(^LRO(69,LRCDT,1,LRSN,2,LRTST,0)) S LREN5=^(0)
. Q:'$P(LREN5,U,11)
. S LRAA=$P(LREN5,U,4),LRTSTP=+LREN5
. I LRAAX,LRAAX'=LRAA,$D(^TMP("LRPXAPI",$J,"PROCEDURE")) D SEND^LRCAPPH1 K ^TMP("LRPXAPI",$J) S LRCNT=1
. D LOC^LRCAPPH1 S LRAAX=LRAA
. I $S('$G(LRDSSID):1,$G(LRNOP):1,1:0) K ^TMP("LRPXAPI",$J) Q
. D EN6^LRCAPPH1
. I $D(^TMP("LRPXAPI",$J,"PROCEDURE")) D SEND^LRCAPPH1
. K ^TMP("LRPXAPI",$J)
END I $D(^TMP("LRPXAPI",$J,"PROCEDURE")) D SEND^LRCAPPH1
L -^LRO("LRCAPPNP","AE")
K:'$G(LRDBUG) ^TMP("LRPXAPI",$J),^TMP("LRMOD",$J),^TMP("PXKENC",$J)
K LREN5,LRNLTN,LRNP,LRNOP,LRNOPX,LRAAX
K LRAEX,LRDAA,LRDPF,LRDSSID,LRNE5,LRNLT,LRSNX,LSTP
K PXALOOK,PXASUB,PXJ,SDCNT,STT1,SPEL,SUBL,TYPEI,XPARSYS
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRCAPPNP 2027 printed Dec 13, 2024@02:13:15 Page 2
LRCAPPNP ;DALOI/FHS - CPT NOT PERFORMED MESSAGES SENDER ; 5/1/99
+1 ;;5.2;LAB SERVICE;**263,264**;Sep 27, 1994
+2 ; Reference to ENCEVENT^PXKENC Supported by DBIA #1889-F
EN ;Called from LRCAPPH
+1 LOCK +^LRO("LRCAPPNP","AE"):1
if '$TEST
QUIT
+2 KILL LRNOP
+3 SET LRAEX="^LRO(69,""AE"",0)"
SET LRNP=1
+4 DO NP^LRCAPPH
if $GET(LRNOPX)
GOTO END
+5 SET (LRCEX,LROA,LRSNX,LRAAX,LRCNT)=0
+6 KILL ^LRO(69,"AE",0),^TMP("LRPXAPI",$JOB),LRXCPT
+7 KILL ^TMP("PXKENC",$JOB)
LOOK ;
+1 NEW LRNPPCE,LRNPX
+2 FOR
SET LRAEX=$QUERY(@LRAEX)
if $QSUBSCRIPT(LRAEX,2)'="AE"
QUIT
Begin DoDot:1
+3 SET LRCDT=$QSUBSCRIPT(LRAEX,4)
SET LRSN=$QSUBSCRIPT(LRAEX,5)
SET LRTST=$QSUBSCRIPT(LRAEX,6)
+4 if +$GET(^LRO(69,LRCDT,1,LRSN,"PCE"))<1
QUIT
SET LRNPPCE=^("PCE")
+5 KILL ^TMP("PXKENC",$JOB),LRNPX
+6 DO ENCEVENT^PXKENC(+LRNPPCE,1)
+7 IF '$ORDER(^TMP("PXKENC",$JOB,+LRNPPCE,"CPT",0))
Begin DoDot:2
End DoDot:2
QUIT
+8 IF LRNPPCE'[+LRNPPCE_"-CPT CANC-ENC DEL"
DO DELCAN^LRCAPPH1
+9 IF $ORDER(^TMP("PXKENC",$JOB,+LRNPPCE,"CPT",0))
Begin DoDot:2
+10 NEW IEN
+11 SET IEN=0
FOR
SET IEN=$ORDER(^TMP("PXKENC",$JOB,+LRNPPCE,"CPT",IEN))
if IEN<1
QUIT
Begin DoDot:3
+12 IF $GET(^TMP("PXKENC",$JOB,+LRNPPCE,"CPT",IEN,0))
SET LRNPX(+^(0))=$PIECE(^(0),U,16)
End DoDot:3
End DoDot:2
+13 IF LRSNX
IF LRSN'=LRSNX
IF $DATA(^TMP("LRPXAPI",$JOB,"PROCEDURE"))
Begin DoDot:2
+14 DO SEND^LRCAPPH1
KILL ^TMP("LRPXAPI",$JOB)
SET LRCNT=1
End DoDot:2
+15 if '$ORDER(LRNPX(0))
QUIT
+16 SET LRSNX=LRSN
+17 KILL LRNOPX
DO LOOK^LRCAPPH
+18 if '$GET(LRNOPX)
QUIT
+19 SET LRNOP=0
DO NP^LRCAPPH1
+20 IF $GET(LRNOP)
SET @LRAEX=LRNOP
SET LRNOP=0
QUIT
+21 if '$DATA(^LRO(69,LRCDT,1,LRSN,2,LRTST,0))
QUIT
SET LREN5=^(0)
+22 if '$PIECE(LREN5,U,11)
QUIT
+23 SET LRAA=$PIECE(LREN5,U,4)
SET LRTSTP=+LREN5
+24 IF LRAAX
IF LRAAX'=LRAA
IF $DATA(^TMP("LRPXAPI",$JOB,"PROCEDURE"))
DO SEND^LRCAPPH1
KILL ^TMP("LRPXAPI",$JOB)
SET LRCNT=1
+25 DO LOC^LRCAPPH1
SET LRAAX=LRAA
+26 IF $SELECT('$GET(LRDSSID):1,$GET(LRNOP):1,1:0)
KILL ^TMP("LRPXAPI",$JOB)
QUIT
+27 DO EN6^LRCAPPH1
+28 IF $DATA(^TMP("LRPXAPI",$JOB,"PROCEDURE"))
DO SEND^LRCAPPH1
+29 KILL ^TMP("LRPXAPI",$JOB)
End DoDot:1
IF '$GET(@LRAEX)
KILL @LRAEX
END IF $DATA(^TMP("LRPXAPI",$JOB,"PROCEDURE"))
DO SEND^LRCAPPH1
+1 LOCK -^LRO("LRCAPPNP","AE")
+2 if '$GET(LRDBUG)
KILL ^TMP("LRPXAPI",$JOB),^TMP("LRMOD",$JOB),^TMP("PXKENC",$JOB)
+3 KILL LREN5,LRNLTN,LRNP,LRNOP,LRNOPX,LRAAX
+4 KILL LRAEX,LRDAA,LRDPF,LRDSSID,LRNE5,LRNLT,LRSNX,LSTP
+5 KILL PXALOOK,PXASUB,PXJ,SDCNT,STT1,SPEL,SUBL,TYPEI,XPARSYS
+6 QUIT
