[613] | 1 | OCXOCMPP ;SLC/RJS,CLA - ORDER CHECK CODE COMPILER (Generate Active Data Purge Logic) ;10/29/98 12:37
|
---|
| 2 | ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32**;Dec 17,1997
|
---|
| 3 | ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
|
---|
| 4 | ;
|
---|
| 5 | EN ;
|
---|
| 6 | ;
|
---|
| 7 | Q:'$$LINE^OCXOCMP4("PURGE") 1
|
---|
| 8 | ;
|
---|
| 9 | S D0=0 F S D0=$O(^OCXS(860.2,D0)) Q:'D0 D
|
---|
| 10 | .Q:$G(^OCXS(860.2,D0,"INACT"))
|
---|
| 11 | .S D1=0 F S D1=$O(^OCXS(860.2,D0,"C",D1)) Q:'D1 D
|
---|
| 12 | ..S SEL=$G(^OCXS(860.2,D0,"C",D1,"SEL"))
|
---|
| 13 | ..S ELE=$P(^OCXS(860.2,D0,"C",D1,0),U,2)
|
---|
| 14 | ..I $L(SEL),'(SEL="LAST"),ELE S OCXSEL(ELE)=""
|
---|
| 15 | ;
|
---|
| 16 | D IN^OCXOCMP4("PURGE"," N OCXE0,OCXE1,OCXS")
|
---|
| 17 | D IN^OCXOCMP4("PURGE"," I $G(DFN) S OCXE0=0 F S OCXE0=$O(^OCXD(860.1,DFN,1,""C"",OCXE0)) Q:'OCXE0 D")
|
---|
| 18 | ;
|
---|
| 19 | S D0=0 F S D0=$O(OCXSEL(D0)) Q:'D0 D IN^OCXOCMP4("PURGE"," .Q:(OCXE0="_D0_")")
|
---|
| 20 | ;
|
---|
| 21 | D IN^OCXOCMP4("PURGE"," .S OCXE1=$O(^OCXD(860.1,DFN,1,""C"",OCXE0,""""),-1) Q:'OCXE1")
|
---|
| 22 | D IN^OCXOCMP4("PURGE"," .S OCXE1=$O(^OCXD(860.1,DFN,1,""C"",OCXE0,OCXE1),-1) Q:'OCXE1")
|
---|
| 23 | D IN^OCXOCMP4("PURGE"," .S OCXE1=$O(^OCXD(860.1,DFN,1,""C"",OCXE0,OCXE1),-1) Q:'OCXE1")
|
---|
| 24 | D IN^OCXOCMP4("PURGE"," .F S OCXE1=$O(^OCXD(860.1,DFN,1,""C"",OCXE0,OCXE1),-1) Q:'OCXE1 D")
|
---|
| 25 | D IN^OCXOCMP4("PURGE"," ..K ^OCXD(860.1,DFN,1,OCXE1)")
|
---|
| 26 | D IN^OCXOCMP4("PURGE"," ..K ^OCXD(860.1,DFN,1,""B"",OCXE1,OCXE1)")
|
---|
| 27 | D IN^OCXOCMP4("PURGE"," ..K ^OCXD(860.1,DFN,1,""C"",OCXE0,OCXE1)")
|
---|
| 28 | ;
|
---|
| 29 | Q
|
---|
| 30 | ;
|
---|