SROPCE ;BIR/ADM - PCE updates ;[ 10/17/01 9:28 AM ]
;;3.0;Surgery;**58,62,69,88,105,119**;24 Jun 93
;
; Reference to $$DATA2PCE^PXAPI supported by DBIA #1889
; Reference to $$DELVFILE^PXAPI supported by DBIA #1890
;
Q
NITE ; entry for nightly update of PCE with surgery & non-OR procedure data
N DFN,SR,SRAO,SRATT,SRCHK,SRCPT,SRDATE,SRDIAG,SRDXN,SREC,SRHNC,SRIR,SRCV,SRK,SRLOC,SRMST,SRNAR,SRNON,SROTH,SRPKG,SRPROV,SRS,SRSC,SRTN,SRV,SRVSIT,SRX
N SRPLSC,SRPLAO,SRPLIR,SRPLEC,SRPLMST,SRPLHNC,SRPLCV,SRADX,SRADX1,SRCNT,SRD,SRDX,SRRPROV,SRUP,SRINOUT,SRODIAG,SRDXF
K DIC S DIC=9.4,DIC(0)="XM",X="SURGERY" D ^DIC K DIC Q:Y=-1 S SRPKG=+Y
S SRS="SURGERY DATA",SRFILE=0 K ^TMP("SRPXAPI",$J)
S SRTN=0 F S SRTN=$O(^SRF("APCE",SRTN)) Q:'SRTN D UTIL K:SRK ^SRF("APCE",SRTN) I 'SRK D PCE
Q
DEL ; delete data from the Visit file and V files
K DA,DIE,DR S DA=SRTN,DIE=130,DR=".015///@" D ^DIE K DA,DIE,DR
S SRV=$$DELVFILE^PXAPI("ALL",SRVSIT) K SRVSIT
Q
UTIL ; set procedure variables
N SRDIV,SRSITE,SRSR
S SRSR="",SRK=0,SRDIV=$P($G(^SRF(SRTN,8)),"^") I SRDIV S SRSITE=$O(^SRO(133,"B",SRDIV,0)),X=^SRO(133,SRSITE,0),SRUP=$P(X,"^",15),SRSR=$P(X,"^",19) I SRUP=""!(SRUP="N") S SRK=1 Q
I 'SRFILE S SRX=$G(^SRF("APCE",SRTN)) I SRX S SRVSIT=SRX D DEL I '$D(^SRF(SRTN,0)) S SRK=1 Q
S SR(0)=$G(^SRF(SRTN,0)) I SR(0)=""!$P($G(^SRF(SRTN,30)),"^") S SRK=1 Q
S DFN=$P(SR(0),"^")
S SRNON=$S($P($G(^SRF(SRTN,"NON")),"^")="Y":1,1:0),SRCPT=$P(^SRF(SRTN,"OP"),"^",2) I 'SRCPT S SRK=1 Q
S SRX=0 F S SRX=$O(^SRF(SRTN,13,SRX)) Q:'SRX I '$P($G(^SRF(SRTN,13,SRX,2)),"^") S SRK=1 Q
Q:SRK S SRDIAG=$P($G(^SRF(SRTN,34)),"^",2) I 'SRDIAG S SRK=1 Q
S SRODIAG=$P($G(^SRF(SRTN,34)),"^",3)
S SRDXF=$S(SRODIAG=SRDIAG:1,1:0)
I 'SRNON D I SRK Q
.S SRX=$P(SR(0),"^",21) I SRX S SRLOC=SRX
.I 'SRX S SRX=$P(^SRO(137.45,$P(SR(0),"^",4),0),"^",5) I SRX S SRLOC=SRX
.I 'SRX S SRX=$P(SR(0),"^",2) S:SRX SRLOC=$P(^SRS(SRX,0),"^") I 'SRX S SRK=1 Q
.S SRX=$G(^SRF(SRTN,.2)),SRCHK=$P(SRX,"^",12) I 'SRCHK S SRK=1 Q
.S SRDATE=$P(SRX,"^",10) I 'SRDATE S SRK=1 Q
.S SRX=$G(^SRF(SRTN,.1)),SRPROV=$P(SRX,"^",4),SRATT=$P(SRX,"^",13) I 'SRPROV S SRK=1 Q
.I SRSR'=0,'SRATT S SRK=1 Q
I SRNON D I SRK Q
.S SRLOC=$P(SR(0),"^",21)
.S SRX=^SRF(SRTN,"NON"),SRCHK=$P(SRX,"^",5) I 'SRCHK S SRK=1 Q
.S SRDATE=$P(SRX,"^",4) I 'SRDATE S SRK=1 Q
.I 'SRLOC S SRLOC=$P(SRX,"^",2) I 'SRLOC S SRK=1 Q
.S SRPROV=$P(SRX,"^",6),SRATT=$P(SRX,"^",7) I 'SRPROV S SRK=1
.I SRSR'=0,'SRATT S SRK=1
S VAINDT=SRDATE
D INP^VADPT
I VAIN(1) S SRINOUT="I"
I 'VAIN(1) S SRINOUT="O"
K VAINDT,VAIN
I '$$CLINIC^SROUTL(SRLOC,SRTN) S SRK=1 Q
S SRX=0,SRX=$O(^SRF(SRTN,"PADX",SRX)) I SRX="" S SRK=1 Q
S SRX=0 F S SRX=$O(^SRF(SRTN,13,SRX)) Q:'SRX I $D(^SRF(SRTN,13,SRX)),'$D(^SRF(SRTN,13,SRX,"OADX")) S SRK=1 Q:SRK
S SRX=0 F S SRX=$O(^SRF(SRTN,15,SRX)) Q:'SRX I '$P($G(^SRF(SRTN,15,SRX,0)),"^",3) S SRK=1 Q:SRK
S SRRPROV="" I $D(^SRF(SRTN,18)) S SRX=0,SRX=$O(^SRF(SRTN,18,SRX)) I SRX S SRRPROV=$P($G(^SRF(SRTN,18,SRX,0)),"^",7)
S (SRSC,SRAO,SREC,SRHNC,SRIR,SRMST,SRCV)=0,SRSC=$P(SR(0),"^",16),SRAO=$P(SR(0),"^",17),SRIR=$P(SR(0),"^",18),SREC=$P(SR(0),"^",19),SRMST=$P(SR(0),"^",22),SRHNC=$P(SR(0),"^",23),SRCV=$P(SR(0),"^",24)
Q
PCE ; set up call to PCE
N SRI,SRJ,SRCODE,SROTH D TMP
D2PCE S SRV=$$DATA2PCE^PXAPI("^TMP(""SRPXAPI"",$J)",SRPKG,SRS,.SRVSIT) I SRVSIT K DA,DIE,DR S DA=SRTN,DIE=130,DR=".015////"_SRVSIT D ^DIE K DA,DIE,DR,^SRF("APCE",SRTN)
K ^TMP("SRPXAPI",$J),SRVSIT
Q
TMP ; set up ^TMP global array
ENC S ^TMP("SRPXAPI",$J,"ENCOUNTER",1,"ENC D/T")=SRDATE
S ^TMP("SRPXAPI",$J,"ENCOUNTER",1,"PATIENT")=DFN
S ^TMP("SRPXAPI",$J,"ENCOUNTER",1,"HOS LOC")=SRLOC
S ^TMP("SRPXAPI",$J,"ENCOUNTER",1,"CHECKOUT D/T")=SRCHK
S ^TMP("SRPXAPI",$J,"ENCOUNTER",1,"SERVICE CATEGORY")="S"
S ^TMP("SRPXAPI",$J,"ENCOUNTER",1,"ENCOUNTER TYPE")="P"
S ^TMP("SRPXAPI",$J,"ENCOUNTER",1,"APPT")=9
S ^TMP("SRPXAPI",$J,"ENCOUNTER",1,"SC")=SRSC
S ^TMP("SRPXAPI",$J,"ENCOUNTER",1,"AO")=SRAO
S ^TMP("SRPXAPI",$J,"ENCOUNTER",1,"IR")=SRIR
S ^TMP("SRPXAPI",$J,"ENCOUNTER",1,"EC")=SREC
S ^TMP("SRPXAPI",$J,"ENCOUNTER",1,"MST")=SRMST
S ^TMP("SRPXAPI",$J,"ENCOUNTER",1,"HNC")=SRHNC
S ^TMP("SRPXAPI",$J,"ENCOUNTER",1,"CV")=SRCV
PROC S SRI=1,SRCODE=SRCPT,SRNAR=$P(^SRF(SRTN,"OP"),"^") D PMOD,CPT
S SROTH=0 F S SROTH=$O(^SRF(SRTN,13,SROTH)) Q:'SROTH I $P(^SRF(SRTN,13,SROTH,0),"^",3)'="N" S SRCODE=$P($G(^SRF(SRTN,13,SROTH,2)),"^") I SRCODE S SRNAR=$P(^SRF(SRTN,13,SROTH,0),"^"),SRI=SRI+1 D OMOD,CPT
PROV S ^TMP("SRPXAPI",$J,"PROVIDER",1,"NAME")=SRPROV
S ^TMP("SRPXAPI",$J,"PROVIDER",1,"PRIMARY")=1
I 'SRNON S ^TMP("SRPXAPI",$J,"PROVIDER",1,"COMMENT")="Surgeon"
I SRPROV=SRATT!'SRATT S ^TMP("SRPXAPI",$J,"PROVIDER",1,"ATTENDING")=1 G DIAG
I 'SRATT G DIAG
S ^TMP("SRPXAPI",$J,"PROVIDER",2,"NAME")=SRATT
S ^TMP("SRPXAPI",$J,"PROVIDER",2,"ATTENDING")=1
S ^TMP("SRPXAPI",$J,"PROVIDER",2,"PRIMARY")=0
I 'SRNON S ^TMP("SRPXAPI",$J,"PROVIDER",2,"COMMENT")="Attending Surgeon"
DIAG S SRI=1,SRDX=SRDIAG,SRDXN=$S(SRNON:$P($G(^SRF(SRTN,33)),"^",2),1:$P($G(^SRF(SRTN,34)),"^")) D DX
S SRD=0 F S SRD=$O(^SRF(SRTN,15,SRD)) Q:'SRD S SRDX=$P(^SRF(SRTN,15,SRD,0),"^",3) I SRDX S SRDXN=$P(^SRF(SRTN,15,SRD,0),"^") D DX
I 'SRDXF,SRODIAG D
.S ^TMP("SRPXAPI",$J,"DX/PL",SRI,"DIAGNOSIS")=SRODIAG
.S ^TMP("SRPXAPI",$J,"DX/PL",SRI,"ORD/RES")="O"
.S SRDXN=$P($G(^SRF(SRTN,33)),"^")
.I SRDXN'="" S ^TMP("SRPXAPI",$J,"DX/PL",SRI,"NARRATIVE")=SRDXN
Q
DX S ^TMP("SRPXAPI",$J,"DX/PL",SRI,"DIAGNOSIS")=SRDX
I SRI=1 D
.S ^TMP("SRPXAPI",$J,"DX/PL",1,"PRIMARY")=1
.I SRDXF S ^TMP("SRPXAPI",$J,"DX/PL",1,"ORD/RES")="OR"
.I 'SRDXF S ^TMP("SRPXAPI",$J,"DX/PL",1,"ORD/RES")="R"
.S ^TMP("SRPXAPI",$J,"DX/PL",1,"PL SC")=SRSC
.S ^TMP("SRPXAPI",$J,"DX/PL",1,"PL AO")=SRAO
.S ^TMP("SRPXAPI",$J,"DX/PL",1,"PL IR")=SRIR
.S ^TMP("SRPXAPI",$J,"DX/PL",1,"PL EC")=SREC
.S ^TMP("SRPXAPI",$J,"DX/PL",1,"PL MST")=SRMST
.S ^TMP("SRPXAPI",$J,"DX/PL",1,"PL HNC")=SRHNC
.S ^TMP("SRPXAPI",$J,"DX/PL",1,"PL CV")=SRCV
I SRI'=1 D
.S SR(15)=$G(^SRF(SRTN,15,SRD,2))
.S (SRPLSC,SRPLAO,SRPLIR,SRPLEC,SRPLMST,SRPLHNC,SRPLCV)=0,SRPLSC=$P(SR(15),"^",1),SRPLAO=$P(SR(15),"^",2),SRPLIR=$P(SR(15),"^",3),SRPLMST=$P(SR(15),"^",4),SRPLHNC=$P(SR(15),"^",5),SRPLEC=$P(SR(15),"^",6),SRPLCV=$P(SR(15),"^",7)
.S ^TMP("SRPXAPI",$J,"DX/PL",SRI,"ORD/RES")="R"
.S ^TMP("SRPXAPI",$J,"DX/PL",SRI,"PL SC")=SRPLSC
.S ^TMP("SRPXAPI",$J,"DX/PL",SRI,"PL AO")=SRPLAO
.S ^TMP("SRPXAPI",$J,"DX/PL",SRI,"PL IR")=SRPLIR
.S ^TMP("SRPXAPI",$J,"DX/PL",SRI,"PL EC")=SRPLEC
.S ^TMP("SRPXAPI",$J,"DX/PL",SRI,"PL MST")=SRPLMST
.S ^TMP("SRPXAPI",$J,"DX/PL",SRI,"PL HNC")=SRPLHNC
.S ^TMP("SRPXAPI",$J,"DX/PL",SRI,"PL CV")=SRPLCV
I SRDXN'="" S ^TMP("SRPXAPI",$J,"DX/PL",SRI,"NARRATIVE")=SRDXN
S SRI=SRI+1
Q
CPT S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"ENC PROVIDER")=SRPROV
S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"ORD PROVIDER")=SRRPROV
S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"EVENT D/T")=SRDATE
S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"PROCEDURE")=SRCODE
S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"NARRATIVE")=SRNAR
S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"QTY")=1
S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"COMMENT")=$S(SRI=1:"Principal Procedure",1:"Other Procedure")
I SRI=1 D
.S SRCNT=1,SRX=0 F S SRX=$O(^SRF(SRTN,"PADX",SRX)) Q:'SRX D
..S SRADX1=$P(^SRF(SRTN,"PADX",SRX,0),"^",1)
..I SRADX1=0 S SRADX=SRDIAG ; 0 IS A FLAG USED TO INDICATE DX IS PRIMARY DX AND NOT OTHER DX
..I SRADX1'=0 S SRADX=$P(^SRF(SRTN,15,SRADX1,0),"^",3)
..I SRCNT=1 S ^TMP("SRPXAPI",$J,"PROCEDURE",1,"DIAGNOSIS")=SRADX
..I SRCNT=2 S ^TMP("SRPXAPI",$J,"PROCEDURE",1,"DIAGNOSIS 2")=SRADX
..I SRCNT=3 S ^TMP("SRPXAPI",$J,"PROCEDURE",1,"DIAGNOSIS 3")=SRADX
..I SRCNT=4 S ^TMP("SRPXAPI",$J,"PROCEDURE",1,"DIAGNOSIS 4")=SRADX
..I SRCNT=5 S ^TMP("SRPXAPI",$J,"PROCEDURE",1,"DIAGNOSIS 5")=SRADX
..I SRCNT=6 S ^TMP("SRPXAPI",$J,"PROCEDURE",1,"DIAGNOSIS 6")=SRADX
..I SRCNT=7 S ^TMP("SRPXAPI",$J,"PROCEDURE",1,"DIAGNOSIS 7")=SRADX
..I SRCNT=8 S ^TMP("SRPXAPI",$J,"PROCEDURE",1,"DIAGNOSIS 8")=SRADX
..S SRCNT=SRCNT+1
I SRI'=1 D
.S SRCNT=1,SRX=0 F S SRX=$O(^SRF(SRTN,13,SROTH,"OADX",SRX)) Q:'SRX D
..S SRADX1=$P(^SRF(SRTN,13,SROTH,"OADX",SRX,0),"^",1)
..I SRADX1=0 S SRADX=SRDIAG ; 0 IS A FLAG USED TO INDICATE DX IS PRIMARY DX AND NOT OTHER DX
..I SRADX1'=0 S SRADX=$P(^SRF(SRTN,15,SRADX1,0),"^",3)
..I SRCNT=1 S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"DIAGNOSIS")=SRADX
..I SRCNT=2 S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"DIAGNOSIS 2")=SRADX
..I SRCNT=3 S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"DIAGNOSIS 3")=SRADX
..I SRCNT=4 S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"DIAGNOSIS 4")=SRADX
..I SRCNT=5 S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"DIAGNOSIS 5")=SRADX
..I SRCNT=6 S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"DIAGNOSIS 6")=SRADX
..I SRCNT=7 S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"DIAGNOSIS 7")=SRADX
..I SRCNT=8 S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"DIAGNOSIS 8")=SRADX
..S SRCNT=SRCNT+1
Q
PMOD ; get modifiers for principal CPT code
N SRM,SRMOD,X
S SRM=0 F S SRM=$O(^SRF(SRTN,"OPMOD",SRM)) Q:'SRM S X=$P(^SRF(SRTN,"OPMOD",SRM,0),"^"),SRMOD=$P($$MOD^ICPTMOD(X,"I"),"^",2),^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"MODIFIERS",SRMOD)=""
S SRMOD="" I $O(^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"MODIFIERS",SRMOD))'="" S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"MODIFIERS")=""
Q
OMOD ; get modifiers for other CPT codes
N SRM,SRMOD,X
S SRM=0 F S SRM=$O(^SRF(SRTN,13,SROTH,"MOD",SRM)) Q:'SRM S X=$P(^SRF(SRTN,13,SROTH,"MOD",SRM,0),"^"),SRMOD=$P($$MOD^ICPTMOD(X,"I"),"^",2),^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"MODIFIERS",SRMOD)=""
S SRMOD="" I $O(^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"MODIFIERS",SRMOD))'="" S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"MODIFIERS")=""
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROPCE 9758 printed Jan 18, 2025@03:46:01 Page 2
SROPCE ;BIR/ADM - PCE updates ;[ 10/17/01 9:28 AM ]
+1 ;;3.0;Surgery;**58,62,69,88,105,119**;24 Jun 93
+2 ;
+3 ; Reference to $$DATA2PCE^PXAPI supported by DBIA #1889
+4 ; Reference to $$DELVFILE^PXAPI supported by DBIA #1890
+5 ;
+6 QUIT
NITE ; entry for nightly update of PCE with surgery & non-OR procedure data
+1 NEW DFN,SR,SRAO,SRATT,SRCHK,SRCPT,SRDATE,SRDIAG,SRDXN,SREC,SRHNC,SRIR,SRCV,SRK,SRLOC,SRMST,SRNAR,SRNON,SROTH,SRPKG,SRPROV,SRS,SRSC,SRTN,SRV,SRVSIT,SRX
+2 NEW SRPLSC,SRPLAO,SRPLIR,SRPLEC,SRPLMST,SRPLHNC,SRPLCV,SRADX,SRADX1,SRCNT,SRD,SRDX,SRRPROV,SRUP,SRINOUT,SRODIAG,SRDXF
+3 KILL DIC
SET DIC=9.4
SET DIC(0)="XM"
SET X="SURGERY"
DO ^DIC
KILL DIC
if Y=-1
QUIT
SET SRPKG=+Y
+4 SET SRS="SURGERY DATA"
SET SRFILE=0
KILL ^TMP("SRPXAPI",$JOB)
+5 SET SRTN=0
FOR
SET SRTN=$ORDER(^SRF("APCE",SRTN))
if 'SRTN
QUIT
DO UTIL
if SRK
KILL ^SRF("APCE",SRTN)
IF 'SRK
DO PCE
+6 QUIT
DEL ; delete data from the Visit file and V files
+1 KILL DA,DIE,DR
SET DA=SRTN
SET DIE=130
SET DR=".015///@"
DO ^DIE
KILL DA,DIE,DR
+2 SET SRV=$$DELVFILE^PXAPI("ALL",SRVSIT)
KILL SRVSIT
+3 QUIT
UTIL ; set procedure variables
+1 NEW SRDIV,SRSITE,SRSR
+2 SET SRSR=""
SET SRK=0
SET SRDIV=$PIECE($GET(^SRF(SRTN,8)),"^")
IF SRDIV
SET SRSITE=$ORDER(^SRO(133,"B",SRDIV,0))
SET X=^SRO(133,SRSITE,0)
SET SRUP=$PIECE(X,"^",15)
SET SRSR=$PIECE(X,"^",19)
IF SRUP=""!(SRUP="N")
SET SRK=1
QUIT
+3 IF 'SRFILE
SET SRX=$GET(^SRF("APCE",SRTN))
IF SRX
SET SRVSIT=SRX
DO DEL
IF '$DATA(^SRF(SRTN,0))
SET SRK=1
QUIT
+4 SET SR(0)=$GET(^SRF(SRTN,0))
IF SR(0)=""!$PIECE($GET(^SRF(SRTN,30)),"^")
SET SRK=1
QUIT
+5 SET DFN=$PIECE(SR(0),"^")
+6 SET SRNON=$SELECT($PIECE($GET(^SRF(SRTN,"NON")),"^")="Y":1,1:0)
SET SRCPT=$PIECE(^SRF(SRTN,"OP"),"^",2)
IF 'SRCPT
SET SRK=1
QUIT
+7 SET SRX=0
FOR
SET SRX=$ORDER(^SRF(SRTN,13,SRX))
if 'SRX
QUIT
IF '$PIECE($GET(^SRF(SRTN,13,SRX,2)),"^")
SET SRK=1
QUIT
+8 if SRK
QUIT
SET SRDIAG=$PIECE($GET(^SRF(SRTN,34)),"^",2)
IF 'SRDIAG
SET SRK=1
QUIT
+9 SET SRODIAG=$PIECE($GET(^SRF(SRTN,34)),"^",3)
+10 SET SRDXF=$SELECT(SRODIAG=SRDIAG:1,1:0)
+11 IF 'SRNON
Begin DoDot:1
+12 SET SRX=$PIECE(SR(0),"^",21)
IF SRX
SET SRLOC=SRX
+13 IF 'SRX
SET SRX=$PIECE(^SRO(137.45,$PIECE(SR(0),"^",4),0),"^",5)
IF SRX
SET SRLOC=SRX
+14 IF 'SRX
SET SRX=$PIECE(SR(0),"^",2)
if SRX
SET SRLOC=$PIECE(^SRS(SRX,0),"^")
IF 'SRX
SET SRK=1
QUIT
+15 SET SRX=$GET(^SRF(SRTN,.2))
SET SRCHK=$PIECE(SRX,"^",12)
IF 'SRCHK
SET SRK=1
QUIT
+16 SET SRDATE=$PIECE(SRX,"^",10)
IF 'SRDATE
SET SRK=1
QUIT
+17 SET SRX=$GET(^SRF(SRTN,.1))
SET SRPROV=$PIECE(SRX,"^",4)
SET SRATT=$PIECE(SRX,"^",13)
IF 'SRPROV
SET SRK=1
QUIT
+18 IF SRSR'=0
IF 'SRATT
SET SRK=1
QUIT
End DoDot:1
IF SRK
QUIT
+19 IF SRNON
Begin DoDot:1
+20 SET SRLOC=$PIECE(SR(0),"^",21)
+21 SET SRX=^SRF(SRTN,"NON")
SET SRCHK=$PIECE(SRX,"^",5)
IF 'SRCHK
SET SRK=1
QUIT
+22 SET SRDATE=$PIECE(SRX,"^",4)
IF 'SRDATE
SET SRK=1
QUIT
+23 IF 'SRLOC
SET SRLOC=$PIECE(SRX,"^",2)
IF 'SRLOC
SET SRK=1
QUIT
+24 SET SRPROV=$PIECE(SRX,"^",6)
SET SRATT=$PIECE(SRX,"^",7)
IF 'SRPROV
SET SRK=1
+25 IF SRSR'=0
IF 'SRATT
SET SRK=1
End DoDot:1
IF SRK
QUIT
+26 SET VAINDT=SRDATE
+27 DO INP^VADPT
+28 IF VAIN(1)
SET SRINOUT="I"
+29 IF 'VAIN(1)
SET SRINOUT="O"
+30 KILL VAINDT,VAIN
+31 IF '$$CLINIC^SROUTL(SRLOC,SRTN)
SET SRK=1
QUIT
+32 SET SRX=0
SET SRX=$ORDER(^SRF(SRTN,"PADX",SRX))
IF SRX=""
SET SRK=1
QUIT
+33 SET SRX=0
FOR
SET SRX=$ORDER(^SRF(SRTN,13,SRX))
if 'SRX
QUIT
IF $DATA(^SRF(SRTN,13,SRX))
IF '$DATA(^SRF(SRTN,13,SRX,"OADX"))
SET SRK=1
if SRK
QUIT
+34 SET SRX=0
FOR
SET SRX=$ORDER(^SRF(SRTN,15,SRX))
if 'SRX
QUIT
IF '$PIECE($GET(^SRF(SRTN,15,SRX,0)),"^",3)
SET SRK=1
if SRK
QUIT
+35 SET SRRPROV=""
IF $DATA(^SRF(SRTN,18))
SET SRX=0
SET SRX=$ORDER(^SRF(SRTN,18,SRX))
IF SRX
SET SRRPROV=$PIECE($GET(^SRF(SRTN,18,SRX,0)),"^",7)
+36 SET (SRSC,SRAO,SREC,SRHNC,SRIR,SRMST,SRCV)=0
SET SRSC=$PIECE(SR(0),"^",16)
SET SRAO=$PIECE(SR(0),"^",17)
SET SRIR=$PIECE(SR(0),"^",18)
SET SREC=$PIECE(SR(0),"^",19)
SET SRMST=$PIECE(SR(0),"^",22)
SET SRHNC=$PIECE(SR(0),"^",23)
SET SRCV=$PIECE(SR(0),"^",24)
+37 QUIT
PCE ; set up call to PCE
+1 NEW SRI,SRJ,SRCODE,SROTH
DO TMP
D2PCE SET SRV=$$DATA2PCE^PXAPI("^TMP(""SRPXAPI"",$J)",SRPKG,SRS,.SRVSIT)
IF SRVSIT
KILL DA,DIE,DR
SET DA=SRTN
SET DIE=130
SET DR=".015////"_SRVSIT
DO ^DIE
KILL DA,DIE,DR,^SRF("APCE",SRTN)
+1 KILL ^TMP("SRPXAPI",$JOB),SRVSIT
+2 QUIT
TMP ; set up ^TMP global array
ENC SET ^TMP("SRPXAPI",$JOB,"ENCOUNTER",1,"ENC D/T")=SRDATE
+1 SET ^TMP("SRPXAPI",$JOB,"ENCOUNTER",1,"PATIENT")=DFN
+2 SET ^TMP("SRPXAPI",$JOB,"ENCOUNTER",1,"HOS LOC")=SRLOC
+3 SET ^TMP("SRPXAPI",$JOB,"ENCOUNTER",1,"CHECKOUT D/T")=SRCHK
+4 SET ^TMP("SRPXAPI",$JOB,"ENCOUNTER",1,"SERVICE CATEGORY")="S"
+5 SET ^TMP("SRPXAPI",$JOB,"ENCOUNTER",1,"ENCOUNTER TYPE")="P"
+6 SET ^TMP("SRPXAPI",$JOB,"ENCOUNTER",1,"APPT")=9
+7 SET ^TMP("SRPXAPI",$JOB,"ENCOUNTER",1,"SC")=SRSC
+8 SET ^TMP("SRPXAPI",$JOB,"ENCOUNTER",1,"AO")=SRAO
+9 SET ^TMP("SRPXAPI",$JOB,"ENCOUNTER",1,"IR")=SRIR
+10 SET ^TMP("SRPXAPI",$JOB,"ENCOUNTER",1,"EC")=SREC
+11 SET ^TMP("SRPXAPI",$JOB,"ENCOUNTER",1,"MST")=SRMST
+12 SET ^TMP("SRPXAPI",$JOB,"ENCOUNTER",1,"HNC")=SRHNC
+13 SET ^TMP("SRPXAPI",$JOB,"ENCOUNTER",1,"CV")=SRCV
PROC SET SRI=1
SET SRCODE=SRCPT
SET SRNAR=$PIECE(^SRF(SRTN,"OP"),"^")
DO PMOD
DO CPT
+1 SET SROTH=0
FOR
SET SROTH=$ORDER(^SRF(SRTN,13,SROTH))
if 'SROTH
QUIT
IF $PIECE(^SRF(SRTN,13,SROTH,0),"^",3)'="N"
SET SRCODE=$PIECE($GET(^SRF(SRTN,13,SROTH,2)),"^")
IF SRCODE
SET SRNAR=$PIECE(^SRF(SRTN,13,SROTH,0),"^")
SET SRI=SRI+1
DO OMOD
DO CPT
PROV SET ^TMP("SRPXAPI",$JOB,"PROVIDER",1,"NAME")=SRPROV
+1 SET ^TMP("SRPXAPI",$JOB,"PROVIDER",1,"PRIMARY")=1
+2 IF 'SRNON
SET ^TMP("SRPXAPI",$JOB,"PROVIDER",1,"COMMENT")="Surgeon"
+3 IF SRPROV=SRATT!'SRATT
SET ^TMP("SRPXAPI",$JOB,"PROVIDER",1,"ATTENDING")=1
GOTO DIAG
+4 IF 'SRATT
GOTO DIAG
+5 SET ^TMP("SRPXAPI",$JOB,"PROVIDER",2,"NAME")=SRATT
+6 SET ^TMP("SRPXAPI",$JOB,"PROVIDER",2,"ATTENDING")=1
+7 SET ^TMP("SRPXAPI",$JOB,"PROVIDER",2,"PRIMARY")=0
+8 IF 'SRNON
SET ^TMP("SRPXAPI",$JOB,"PROVIDER",2,"COMMENT")="Attending Surgeon"
DIAG SET SRI=1
SET SRDX=SRDIAG
SET SRDXN=$SELECT(SRNON:$PIECE($GET(^SRF(SRTN,33)),"^",2),1:$PIECE($GET(^SRF(SRTN,34)),"^"))
DO DX
+1 SET SRD=0
FOR
SET SRD=$ORDER(^SRF(SRTN,15,SRD))
if 'SRD
QUIT
SET SRDX=$PIECE(^SRF(SRTN,15,SRD,0),"^",3)
IF SRDX
SET SRDXN=$PIECE(^SRF(SRTN,15,SRD,0),"^")
DO DX
+2 IF 'SRDXF
IF SRODIAG
Begin DoDot:1
+3 SET ^TMP("SRPXAPI",$JOB,"DX/PL",SRI,"DIAGNOSIS")=SRODIAG
+4 SET ^TMP("SRPXAPI",$JOB,"DX/PL",SRI,"ORD/RES")="O"
+5 SET SRDXN=$PIECE($GET(^SRF(SRTN,33)),"^")
+6 IF SRDXN'=""
SET ^TMP("SRPXAPI",$JOB,"DX/PL",SRI,"NARRATIVE")=SRDXN
End DoDot:1
+7 QUIT
DX SET ^TMP("SRPXAPI",$JOB,"DX/PL",SRI,"DIAGNOSIS")=SRDX
+1 IF SRI=1
Begin DoDot:1
+2 SET ^TMP("SRPXAPI",$JOB,"DX/PL",1,"PRIMARY")=1
+3 IF SRDXF
SET ^TMP("SRPXAPI",$JOB,"DX/PL",1,"ORD/RES")="OR"
+4 IF 'SRDXF
SET ^TMP("SRPXAPI",$JOB,"DX/PL",1,"ORD/RES")="R"
+5 SET ^TMP("SRPXAPI",$JOB,"DX/PL",1,"PL SC")=SRSC
+6 SET ^TMP("SRPXAPI",$JOB,"DX/PL",1,"PL AO")=SRAO
+7 SET ^TMP("SRPXAPI",$JOB,"DX/PL",1,"PL IR")=SRIR
+8 SET ^TMP("SRPXAPI",$JOB,"DX/PL",1,"PL EC")=SREC
+9 SET ^TMP("SRPXAPI",$JOB,"DX/PL",1,"PL MST")=SRMST
+10 SET ^TMP("SRPXAPI",$JOB,"DX/PL",1,"PL HNC")=SRHNC
+11 SET ^TMP("SRPXAPI",$JOB,"DX/PL",1,"PL CV")=SRCV
End DoDot:1
+12 IF SRI'=1
Begin DoDot:1
+13 SET SR(15)=$GET(^SRF(SRTN,15,SRD,2))
+14 SET (SRPLSC,SRPLAO,SRPLIR,SRPLEC,SRPLMST,SRPLHNC,SRPLCV)=0
SET SRPLSC=$PIECE(SR(15),"^",1)
SET SRPLAO=$PIECE(SR(15),"^",2)
SET SRPLIR=$PIECE(SR(15),"^",3)
SET SRPLMST=$PIECE(SR(15),"^",4)
SET SRPLHNC=$PIECE(SR(15),"^",5)
SET SRPLEC=$PIECE(SR(15),"^",6)
SET SRPLCV=$PIECE(SR(15),"^",7)
+15 SET ^TMP("SRPXAPI",$JOB,"DX/PL",SRI,"ORD/RES")="R"
+16 SET ^TMP("SRPXAPI",$JOB,"DX/PL",SRI,"PL SC")=SRPLSC
+17 SET ^TMP("SRPXAPI",$JOB,"DX/PL",SRI,"PL AO")=SRPLAO
+18 SET ^TMP("SRPXAPI",$JOB,"DX/PL",SRI,"PL IR")=SRPLIR
+19 SET ^TMP("SRPXAPI",$JOB,"DX/PL",SRI,"PL EC")=SRPLEC
+20 SET ^TMP("SRPXAPI",$JOB,"DX/PL",SRI,"PL MST")=SRPLMST
+21 SET ^TMP("SRPXAPI",$JOB,"DX/PL",SRI,"PL HNC")=SRPLHNC
+22 SET ^TMP("SRPXAPI",$JOB,"DX/PL",SRI,"PL CV")=SRPLCV
End DoDot:1
+23 IF SRDXN'=""
SET ^TMP("SRPXAPI",$JOB,"DX/PL",SRI,"NARRATIVE")=SRDXN
+24 SET SRI=SRI+1
+25 QUIT
CPT SET ^TMP("SRPXAPI",$JOB,"PROCEDURE",SRI,"ENC PROVIDER")=SRPROV
+1 SET ^TMP("SRPXAPI",$JOB,"PROCEDURE",SRI,"ORD PROVIDER")=SRRPROV
+2 SET ^TMP("SRPXAPI",$JOB,"PROCEDURE",SRI,"EVENT D/T")=SRDATE
+3 SET ^TMP("SRPXAPI",$JOB,"PROCEDURE",SRI,"PROCEDURE")=SRCODE
+4 SET ^TMP("SRPXAPI",$JOB,"PROCEDURE",SRI,"NARRATIVE")=SRNAR
+5 SET ^TMP("SRPXAPI",$JOB,"PROCEDURE",SRI,"QTY")=1
+6 SET ^TMP("SRPXAPI",$JOB,"PROCEDURE",SRI,"COMMENT")=$SELECT(SRI=1:"Principal Procedure",1:"Other Procedure")
+7 IF SRI=1
Begin DoDot:1
+8 SET SRCNT=1
SET SRX=0
FOR
SET SRX=$ORDER(^SRF(SRTN,"PADX",SRX))
if 'SRX
QUIT
Begin DoDot:2
+9 SET SRADX1=$PIECE(^SRF(SRTN,"PADX",SRX,0),"^",1)
+10 ; 0 IS A FLAG USED TO INDICATE DX IS PRIMARY DX AND NOT OTHER DX
IF SRADX1=0
SET SRADX=SRDIAG
+11 IF SRADX1'=0
SET SRADX=$PIECE(^SRF(SRTN,15,SRADX1,0),"^",3)
+12 IF SRCNT=1
SET ^TMP("SRPXAPI",$JOB,"PROCEDURE",1,"DIAGNOSIS")=SRADX
+13 IF SRCNT=2
SET ^TMP("SRPXAPI",$JOB,"PROCEDURE",1,"DIAGNOSIS 2")=SRADX
+14 IF SRCNT=3
SET ^TMP("SRPXAPI",$JOB,"PROCEDURE",1,"DIAGNOSIS 3")=SRADX
+15 IF SRCNT=4
SET ^TMP("SRPXAPI",$JOB,"PROCEDURE",1,"DIAGNOSIS 4")=SRADX
+16 IF SRCNT=5
SET ^TMP("SRPXAPI",$JOB,"PROCEDURE",1,"DIAGNOSIS 5")=SRADX
+17 IF SRCNT=6
SET ^TMP("SRPXAPI",$JOB,"PROCEDURE",1,"DIAGNOSIS 6")=SRADX
+18 IF SRCNT=7
SET ^TMP("SRPXAPI",$JOB,"PROCEDURE",1,"DIAGNOSIS 7")=SRADX
+19 IF SRCNT=8
SET ^TMP("SRPXAPI",$JOB,"PROCEDURE",1,"DIAGNOSIS 8")=SRADX
+20 SET SRCNT=SRCNT+1
End DoDot:2
End DoDot:1
+21 IF SRI'=1
Begin DoDot:1
+22 SET SRCNT=1
SET SRX=0
FOR
SET SRX=$ORDER(^SRF(SRTN,13,SROTH,"OADX",SRX))
if 'SRX
QUIT
Begin DoDot:2
+23 SET SRADX1=$PIECE(^SRF(SRTN,13,SROTH,"OADX",SRX,0),"^",1)
+24 ; 0 IS A FLAG USED TO INDICATE DX IS PRIMARY DX AND NOT OTHER DX
IF SRADX1=0
SET SRADX=SRDIAG
+25 IF SRADX1'=0
SET SRADX=$PIECE(^SRF(SRTN,15,SRADX1,0),"^",3)
+26 IF SRCNT=1
SET ^TMP("SRPXAPI",$JOB,"PROCEDURE",SRI,"DIAGNOSIS")=SRADX
+27 IF SRCNT=2
SET ^TMP("SRPXAPI",$JOB,"PROCEDURE",SRI,"DIAGNOSIS 2")=SRADX
+28 IF SRCNT=3
SET ^TMP("SRPXAPI",$JOB,"PROCEDURE",SRI,"DIAGNOSIS 3")=SRADX
+29 IF SRCNT=4
SET ^TMP("SRPXAPI",$JOB,"PROCEDURE",SRI,"DIAGNOSIS 4")=SRADX
+30 IF SRCNT=5
SET ^TMP("SRPXAPI",$JOB,"PROCEDURE",SRI,"DIAGNOSIS 5")=SRADX
+31 IF SRCNT=6
SET ^TMP("SRPXAPI",$JOB,"PROCEDURE",SRI,"DIAGNOSIS 6")=SRADX
+32 IF SRCNT=7
SET ^TMP("SRPXAPI",$JOB,"PROCEDURE",SRI,"DIAGNOSIS 7")=SRADX
+33 IF SRCNT=8
SET ^TMP("SRPXAPI",$JOB,"PROCEDURE",SRI,"DIAGNOSIS 8")=SRADX
+34 SET SRCNT=SRCNT+1
End DoDot:2
End DoDot:1
+35 QUIT
PMOD ; get modifiers for principal CPT code
+1 NEW SRM,SRMOD,X
+2 SET SRM=0
FOR
SET SRM=$ORDER(^SRF(SRTN,"OPMOD",SRM))
if 'SRM
QUIT
SET X=$PIECE(^SRF(SRTN,"OPMOD",SRM,0),"^")
SET SRMOD=$PIECE($$MOD^ICPTMOD(X,"I"),"^",2)
SET ^TMP("SRPXAPI",$JOB,"PROCEDURE",SRI,"MODIFIERS",SRMOD)=""
+3 SET SRMOD=""
IF $ORDER(^TMP("SRPXAPI",$JOB,"PROCEDURE",SRI,"MODIFIERS",SRMOD))'=""
SET ^TMP("SRPXAPI",$JOB,"PROCEDURE",SRI,"MODIFIERS")=""
+4 QUIT
OMOD ; get modifiers for other CPT codes
+1 NEW SRM,SRMOD,X
+2 SET SRM=0
FOR
SET SRM=$ORDER(^SRF(SRTN,13,SROTH,"MOD",SRM))
if 'SRM
QUIT
SET X=$PIECE(^SRF(SRTN,13,SROTH,"MOD",SRM,0),"^")
SET SRMOD=$PIECE($$MOD^ICPTMOD(X,"I"),"^",2)
SET ^TMP("SRPXAPI",$JOB,"PROCEDURE",SRI,"MODIFIERS",SRMOD)=""
+3 SET SRMOD=""
IF $ORDER(^TMP("SRPXAPI",$JOB,"PROCEDURE",SRI,"MODIFIERS",SRMOD))'=""
SET ^TMP("SRPXAPI",$JOB,"PROCEDURE",SRI,"MODIFIERS")=""
+4 QUIT
