source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORELR2.m@ 1397

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

initial load of FOIAVistA 6/30/08 version
File size: 5.2 KB
Line 
1ORELR2 ; slc/dcm - Cross check file 100 with file 69 ;2/21/96 13:30 ;
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**20,42,169**;Dec 17, 1997
3A ;Enter here
4 N X,ORENT,ORSTS,ORX1,ORX,ORX3,ORSDT,ORITEM,ORX4,ORX6,ORDAD,ORX1,ORDFN,ORPCL,ORSTS,ORSTRT,ORENT,ORWHO,ORSIB,ORPSTS,LRDFN,LRODT,LRORD,LRSN,LRSTS
5 S (ORENT,ORSTS,ORX1)=""
6 I '$D(^OR(100,ORIFN,0)) D WRT(ORIFN,"No ^OR(100,ORIFN,0)") K:ORAFIX ^OR(100,ORIFN) Q
7 I '$D(^OR(100,ORIFN,3)) D WRT(ORIFN,"No ^OR(100,ORIFN,3)") D:ORAFIX PURG^ORELR3(ORIFN) Q
8 S ORX=^OR(100,ORIFN,0),ORX3=$G(^(3)),ORSDT=$P(ORX3,"^",6),ORITEM=$P(ORX3,"^",7),ORX4=$G(^(4)),ORX6=$G(^(6)),ORDAD=$O(^(2,0)),ORX1=$O(^OR(100,ORIFN,1,0)),ORX1=$E($G(^(+ORX1,0)),1,15),ORDFN=$P(ORX,"^",2)
9 I '$P(ORX,"^",14) D WRT(ORIFN,"No package defined") D:ORAFIX PURG^ORELR3(ORIFN) Q
10 Q:$P(ORX,"^",14)'=PKG
11 Q:ORDFN'[";DPT("
12 S ORPCL=$P(ORX3,"^",4),ORSTS=$P(ORX3,"^",3),ORSTRT=$P(ORX,"^",8),ORENT=$P(ORX,"^",7),ORWHO=$P(ORX,"^",6),ORSIB=$P(ORX3,"^",9)
13 D NOW^%DTC
14 I ORENT>+($E(%,1,10)-.01) Q
15 I ORSTS=99 D WRT(ORIFN,"No Status",1) S NCNT=NCNT+1 Q
16 I ORPCL,ORPCL[";ORD(101,",$D(^ORD(101,+ORPCL,0)),$P(^(0),"^")["ORGY " Q
17 I $P(ORX3,"^",8),DT>$P(ORENT,".") D
18 . I ORSTS=2,ORAFIX S $P(^OR(100,ORIFN,3),"^",8)="" Q ;Unveil completed order
19 . S VCNT=VCNT+1
20 . D WRT(ORIFN,"Old Veiled order: ORPK="_ORX4)
21 . D:ORAFIX PURG^ORELR3(ORIFN)
22 I ORDAD S ORPSTS=ORSTS D DAD^ORELR3(ORIFN) Q
23 I ORSIB D
24 . I '$D(^OR(100,ORSIB)) S SIBCNT=SIBCNT+1 D WRT(ORIFN,"Child order with no parent") S:ORAFIX $P(^OR(100,ORIFN,3),"^",9)="" Q
25 . I '$D(^OR(100,ORSIB,2,ORIFN)) S SIBPCNT=SIBPCNT+1 D WRT(ORIFN,"Child order with missing parent pointer") I ORAFIX S ^OR(100,ORSIB,2,ORIFN,0)=ORIFN
26 I ORSTS=11,ORPENDT,ORSTRT<ORPENDT D DC^ORELR3 Q
27 Q:$P(ORX3,"^",3)=11
28 Q:$P(ORX3,"^",3)=10
29 I $L($P(ORX4,"^",4,99)) Q:$P(ORX3,"^",3)=1 D Q
30 . I 'ORSTS S BSCNT=BSCNT+1 D WRT(ORIFN,"Bad package link, null status:"_ORX4) I '$P(ORX4,"^",4) D:ORAFIX PURG^ORELR3(ORIFN) Q
31 . I ORSTS'=1 S UCCNT=UCCNT+1 D WRT(ORIFN,"Unrecognized package link:"_ORX4) D:ORAFIX STATUS^ORCSAVE2(ORIFN,1)
32 I '$D(^OR(100,ORIFN,4)) D Q
33 . I ORSTS'=1,ORSTS'=2,'(ORSTS>8&(ORSTS<15)),$P(ORX3,"^",13)'=2 D WRT(ORIFN,"No package node") S UCCNT=UCCNT+1 D:ORAFIX STATUS^ORCSAVE2(ORIFN,1)
34 I '$L(^OR(100,ORIFN,4)) D Q
35 . I ORSTS'=1,ORSTS'=2,'(ORSTS>8&(ORSTS<15)) D WRT(ORIFN,"Empty package node") S UCCNT=UCCNT+1 D:ORAFIX STATUS^ORCSAVE2(ORIFN,1)
36 I ORX4["^" D Q
37 . I ORSTS=""!(ORSTS=1)!(ORSTS=2)!(ORSTS=14)!(ORSTS=12) Q
38 . S UNCNT=UNCNT+1
39 . I ORLRO,'$D(^LRO(69,+ORX4,1,$P(ORX4,"^",2),2,$P(ORX4,"^",3))) D WRT(ORIFN,"Didn't get converted, NOT IN 69") D:ORAFIX STATUS^ORCSAVE2(ORIFN,14) Q
40 . I '$D(^LRO(69,+ORX4,1,+$P(ORX4,"^",2))) D WRT(ORIFN,"Didn't get converted") D:ORAFIX STATUS^ORCSAVE2(ORIFN,14) Q
41 . S UNCNT=UNCNT-1
42 I ORX4'[";" D Q
43 . I ORLRO,'$D(^LRO(69,"C",+ORX4)),ORSTS'=14,ORSTS'=1,ORSTS'=2 S NOCNT=NOCNT+1 D WRT(ORIFN,"ORD# not in 69:"_ORX4) D:ORAFIX STATUS^ORCSAVE2(ORIFN,14)
44 S LRORD=+ORX4,LRODT=$P(ORX4,";",2),LRSN=$P(ORX4,";",3),LRSTS=""
45 I 'LRORD!('LRODT)!('LRSN),ORSTS'=1,ORSTS'=14,ORSTS'=2 D WRT(ORIFN,"Invalid ORPK:"_LRORD_";"_LRODT_";"_LRSN) S IVCNT=IVCNT+1 D:ORAFIX STATUS^ORCSAVE2(ORIFN,14) Q
46 I ORLRO,ORSTS'=1,ORSTS'=14,ORSTS'=2,LRODT,LRSN,'$D(^LRO(69,LRODT,1,LRSN,0)) S LCNT=LCNT+1 D WRT(ORIFN,"No entry in 69:"_LRODT_";"_LRSN) D:ORAFIX STATUS^ORCSAVE2(ORIFN,14) Q
47 I ORDFN[";DPT(",LRODT,LRSN S LRDFN=+$G(^DPT(+ORDFN,"LR")),X=+$G(^LRO(69,LRODT,1,LRSN,0)) I X,X'=LRDFN S X="Wrong patient! OR:"_LRDFN_" LR:"_X_" ORPK:"_LRODT_";"_LRSN,DCNT=DCNT+1 D WRT(ORIFN,X,1) Q
48 I 'ORWHO D WRT(ORIFN,"No 'Entered by'",1) S WICNT=WICNT+1
49 I '$P(ORX,"^",4),LRODT,LRSN S PHCNT=PHCNT+1 D
50 . S X=$P($G(^LRO(69,LRODT,1,LRSN,0)),"^",6)
51 . D WRT(ORIFN,"No Physician in 100"_$S('X:" or 69",1:""),$S(X:"",1:1))
52 . I X,ORAFIX S $P(^OR(100,ORIFN,0),"^",4)=X S:'$P(^(3),"^",7) $P(^(3),"^",7)=X
53 I $D(^LRO(69,+LRODT,1,+LRSN,1)) S LRSTS=$P(^(1),"^",4)
54 S I=0
55 I LRSTS="",$D(^LRO(69,+LRODT,1,+LRSN,6)) S J=0 F S J=$O(^LRO(69,LRODT,1,LRSN,6,J)) Q:J<1 I ^(J,0)["NO DRAW for test" S I=1 Q
56 I I,ORSTS'=2,ORSTS'=1,ORSTS'=9 D WRT(ORIFN,"Active canceled order") S ACNT=ACNT+1 D:ORAFIX STATUS^ORCSAVE2(ORIFN,1)
57 I ORSTS=9 S ICCNT=ICCNT+1 D WRT(ORIFN,"Incomplete should be Complete") D:ORAFIX STATUS^ORCSAVE2(ORIFN,2)
58 I ORSTS'=1,ORSTS'=2,ORSTS'=9,$D(^LRO(69,+LRODT,1,+LRSN,3)),$P(^(3),"^",2) N LRTN S LRTN=0 F S LRTN=$O(^LRO(69,LRODT,1,LRSN,2,LRTN)) Q:'LRTN S X=^(LRTN,0) I $P(X,"^",7)=ORIFN,$P(X,"^",3),$P(X,"^",4),$P(X,"^",5) D
59 . S X1=$G(^LRO(68,$P(X,"^",4),1,$P(X,"^",3),1,$P(X,"^",5),4,+X,0))
60 . I $P(X1,"^",5) D WRT(ORIFN,"Status should be Complete") S STCNT=STCNT+1 D:ORAFIX STATUS^ORCSAVE2(ORIFN,2)
61 I ORSTS'=1,ORSTS'=2,ORSTS'=13,ORSTS'=14 N ORI,ORX S ORI=0 F S ORI=$O(^OR(100,ORIFN,4.5,"ID","ORDERABLE",ORI)) Q:ORI<1 I $D(^OR(100,ORIFN,4.5,ORI,1)) S ORX=^(1) I $D(^ORD(101.43,+ORX,0)) S ORX=+$P(^(0),"^",2) I ORX D
62 . I $D(^LRO(69,LRODT,1,LRSN,2,"B",ORX)) S ORX=$O(^(ORX,0)) I '$L($P(^LRO(69,LRODT,1,LRSN,2,ORX,0),"^",7)) D WRT(ORIFN,"Missing pointer to 100") S OCNT=OCNT+1 I ORAFIX S $P(^LRO(69,LRODT,1,LRSN,2,ORX,0),"^",7)=ORIFN
63 D DC^ORELR3
64 Q
65WRT(ORIFN,TEXT,FIX) ;Disp
66 S CNT=CNT+1,TTCNT=TTCNT+1
67 Q:$E(IOST,1,2)="P-"
68 ;I CNT>100 W !!,"Continue" S %=1 D YN^DICN S CNT=0 I %=2 S END=1
69 ;W !,ORIFN_"=>"_ORX1_"<"_$G(ORENT)_">"_$G(ORSTS)_"<"_TEXT_$S($G(FIX):">Not fixed",1:"")
70 W "."
71 Q
Note: See TracBrowser for help on using the repository browser.