| 1 | PRCPRPC1 ;WISC/RFJ,DWA-patient distribution costs (sort) ;11 Mar 94
|
|---|
| 2 | ;;5.1;IFCAP;**27**;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | Q
|
|---|
| 5 | ;
|
|---|
| 6 | ;
|
|---|
| 7 | SORT ; sort data
|
|---|
| 8 | K ^TMP($J,"PRCPRPCR"),^TMP($J,"PRCPRPCRT")
|
|---|
| 9 | S DA=DATESTRT-.00000001
|
|---|
| 10 | F S DA=$O(^PRCP(446.1,DA)) Q:'DA!($P(DA,".")>DATEEND) S DATA=$G(^(DA,0)),SURGDATA=$G(^(130)) I DATA'="" D
|
|---|
| 11 | . ; check distribution point
|
|---|
| 12 | . S DISTRPT=+$P(DATA,"^",6)
|
|---|
| 13 | . I 'DISTRPT,'$G(DISTRALL) Q
|
|---|
| 14 | . I $G(DISTRALL),$D(^TMP($J,"PRCPURS3","NO",DISTRPT)) Q
|
|---|
| 15 | . I '$G(DISTRALL),'$D(^TMP($J,"PRCPURS3","YES",DISTRPT)) Q
|
|---|
| 16 | . S DISTRNM=$P($$INVNAME^PRCPUX1(DISTRPT),"-",2) S:DISTRNM="" DISTRNM=" "
|
|---|
| 17 | . ;
|
|---|
| 18 | . ; check surgical specialty
|
|---|
| 19 | . S SURGSPEC=$P($G(^SRO(137.45,+$P(SURGDATA,"^",3),0)),"^") S:SURGSPEC="" SURGSPEC=" "
|
|---|
| 20 | . I SURGSPEC']PRCPSURS!(PRCPSURE']SURGSPEC) Q
|
|---|
| 21 | . ;
|
|---|
| 22 | . ; check patient
|
|---|
| 23 | . S DFN=+$P(DATA,"^",3),(PATNAME,SSN)=" " I $$VERSION^XPDUTL("DG"),DFN D DEM^VADPT
|
|---|
| 24 | . S PATNAME=$G(VADM(1)),SSN=$P($G(VADM(2)),"^",2)
|
|---|
| 25 | . I PATNAME']PRCPPATS!(PRCPPATE']PATNAME) Q
|
|---|
| 26 | . ;
|
|---|
| 27 | . ; check opcode
|
|---|
| 28 | . S OPCODE=$P($$ICPT^PRCPCUT1(+$P(SURGDATA,"^")),"^") I OPCODE="" S OPCODE=" "
|
|---|
| 29 | . I OPCODE']PRCPOPCS!(PRCPOPCE']OPCODE) Q
|
|---|
| 30 | . ;
|
|---|
| 31 | . S INOUTPAT=$P(DATA,"^",4) I INOUTPAT="" S INOUTPAT=" "
|
|---|
| 32 | . S ^TMP($J,"PRCPRPCR",$E(DISTRNM,1,15),$E(SURGSPEC,1,15),INOUTPAT,$E($P(PATNAME,","),1,4)_"-"_$E($P(SSN,"-",3),1,4),OPCODE,DA)=$P(SURGDATA,"^",2)_"^"_$P(SURGDATA,"^",4)_"^"_$P(DATA,"^",5)
|
|---|
| 33 | Q
|
|---|
