49 lines
1.9 KiB
Mathematica
49 lines
1.9 KiB
Mathematica
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
|