34 lines
1.5 KiB
Mathematica
34 lines
1.5 KiB
Mathematica
PRCPRPC1 ;WISC/RFJ,DWA-patient distribution costs (sort) ;11 Mar 94
|
|
;;5.1;IFCAP;**27**;Oct 20, 2000
|
|
;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
Q
|
|
;
|
|
;
|
|
SORT ; sort data
|
|
K ^TMP($J,"PRCPRPCR"),^TMP($J,"PRCPRPCRT")
|
|
S DA=DATESTRT-.00000001
|
|
F S DA=$O(^PRCP(446.1,DA)) Q:'DA!($P(DA,".")>DATEEND) S DATA=$G(^(DA,0)),SURGDATA=$G(^(130)) I DATA'="" D
|
|
. ; check distribution point
|
|
. S DISTRPT=+$P(DATA,"^",6)
|
|
. I 'DISTRPT,'$G(DISTRALL) Q
|
|
. I $G(DISTRALL),$D(^TMP($J,"PRCPURS3","NO",DISTRPT)) Q
|
|
. I '$G(DISTRALL),'$D(^TMP($J,"PRCPURS3","YES",DISTRPT)) Q
|
|
. S DISTRNM=$P($$INVNAME^PRCPUX1(DISTRPT),"-",2) S:DISTRNM="" DISTRNM=" "
|
|
. ;
|
|
. ; check surgical specialty
|
|
. S SURGSPEC=$P($G(^SRO(137.45,+$P(SURGDATA,"^",3),0)),"^") S:SURGSPEC="" SURGSPEC=" "
|
|
. I SURGSPEC']PRCPSURS!(PRCPSURE']SURGSPEC) Q
|
|
. ;
|
|
. ; check patient
|
|
. S DFN=+$P(DATA,"^",3),(PATNAME,SSN)=" " I $$VERSION^XPDUTL("DG"),DFN D DEM^VADPT
|
|
. S PATNAME=$G(VADM(1)),SSN=$P($G(VADM(2)),"^",2)
|
|
. I PATNAME']PRCPPATS!(PRCPPATE']PATNAME) Q
|
|
. ;
|
|
. ; check opcode
|
|
. S OPCODE=$P($$ICPT^PRCPCUT1(+$P(SURGDATA,"^")),"^") I OPCODE="" S OPCODE=" "
|
|
. I OPCODE']PRCPOPCS!(PRCPOPCE']OPCODE) Q
|
|
. ;
|
|
. S INOUTPAT=$P(DATA,"^",4) I INOUTPAT="" S INOUTPAT=" "
|
|
. 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)
|
|
Q
|