source: FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LRCAPPNP.m@ 1800

Last change on this file since 1800 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 1.9 KB
Line 
1LRCAPPNP ;DALOI/FHS - CPT NOT PERFORMED MESSAGES SENDER ; 5/1/99
2 ;;5.2;LAB SERVICE;**263,264**;Sep 27, 1994
3 ; Reference to ENCEVENT^PXKENC Supported by DBIA #1889-F
4EN ;Called from LRCAPPH
5 L +^LRO("LRCAPPNP","AE"):1 Q:'$T
6 K LRNOP
7 S LRAEX="^LRO(69,""AE"",0)",LRNP=1
8 D NP^LRCAPPH G:$G(LRNOPX) END
9 S (LRCEX,LROA,LRSNX,LRAAX,LRCNT)=0
10 K ^LRO(69,"AE",0),^TMP("LRPXAPI",$J),LRXCPT
11 K ^TMP("PXKENC",$J)
12LOOK ;
13 N LRNPPCE,LRNPX
14 F S LRAEX=$Q(@LRAEX) Q:$QS(LRAEX,2)'="AE" D I '$G(@LRAEX) K @LRAEX
15 . S LRCDT=$QS(LRAEX,4),LRSN=$QS(LRAEX,5),LRTST=$QS(LRAEX,6)
16 . Q:+$G(^LRO(69,LRCDT,1,LRSN,"PCE"))<1 S LRNPPCE=^("PCE")
17 . K ^TMP("PXKENC",$J),LRNPX
18 . D ENCEVENT^PXKENC(+LRNPPCE,1)
19 . I '$O(^TMP("PXKENC",$J,+LRNPPCE,"CPT",0)) D Q
20 . I LRNPPCE'[+LRNPPCE_"-CPT CANC-ENC DEL" D DELCAN^LRCAPPH1
21 . I $O(^TMP("PXKENC",$J,+LRNPPCE,"CPT",0)) D
22 . . N IEN
23 . . S IEN=0 F S IEN=$O(^TMP("PXKENC",$J,+LRNPPCE,"CPT",IEN)) Q:IEN<1 D
24 . . . I $G(^TMP("PXKENC",$J,+LRNPPCE,"CPT",IEN,0)) S LRNPX(+^(0))=$P(^(0),U,16)
25 . I LRSNX,LRSN'=LRSNX,$D(^TMP("LRPXAPI",$J,"PROCEDURE")) D
26 . . D SEND^LRCAPPH1 K ^TMP("LRPXAPI",$J) S LRCNT=1
27 . Q:'$O(LRNPX(0))
28 . S LRSNX=LRSN
29 . K LRNOPX D LOOK^LRCAPPH
30 . Q:'$G(LRNOPX)
31 . S LRNOP=0 D NP^LRCAPPH1
32 . I $G(LRNOP) S @LRAEX=LRNOP,LRNOP=0 Q
33 . Q:'$D(^LRO(69,LRCDT,1,LRSN,2,LRTST,0)) S LREN5=^(0)
34 . Q:'$P(LREN5,U,11)
35 . S LRAA=$P(LREN5,U,4),LRTSTP=+LREN5
36 . I LRAAX,LRAAX'=LRAA,$D(^TMP("LRPXAPI",$J,"PROCEDURE")) D SEND^LRCAPPH1 K ^TMP("LRPXAPI",$J) S LRCNT=1
37 . D LOC^LRCAPPH1 S LRAAX=LRAA
38 . I $S('$G(LRDSSID):1,$G(LRNOP):1,1:0) K ^TMP("LRPXAPI",$J) Q
39 . D EN6^LRCAPPH1
40 . I $D(^TMP("LRPXAPI",$J,"PROCEDURE")) D SEND^LRCAPPH1
41 . K ^TMP("LRPXAPI",$J)
42END I $D(^TMP("LRPXAPI",$J,"PROCEDURE")) D SEND^LRCAPPH1
43 L -^LRO("LRCAPPNP","AE")
44 K:'$G(LRDBUG) ^TMP("LRPXAPI",$J),^TMP("LRMOD",$J),^TMP("PXKENC",$J)
45 K LREN5,LRNLTN,LRNP,LRNOP,LRNOPX,LRAAX
46 K LRAEX,LRDAA,LRDPF,LRDSSID,LRNE5,LRNLT,LRSNX,LSTP
47 K PXALOOK,PXASUB,PXJ,SDCNT,STT1,SPEL,SUBL,TYPEI,XPARSYS
48 Q
Note: See TracBrowser for help on using the repository browser.