SROPCEP ;BIR/TJH - PCE UPDATES ;04/26/05 9:28 AM
;;3.0; Surgery ;**142,152,144,161**;24 Jun 93;Build 5
;
; Reference to $$DATA2PCE^PXAPI supported by DBIA #1889
; Reference to $$DELVFILE^PXAPI supported by DBIA #1890
; Reference to ^DIC(45.3 is supported by DBIA #218
;
Q
START ; entry for update to PCE with surgery & non-OR procedure data
I '$D(SRTN) S SRTN=$G(DA)
I SRTN="" Q
N DFN,SR,SRAO,SRATT,SRCHK,SRCPT,SRDATE,SRDIAG,SREC,SRHNC,SRIR,SRCV,SRPRJ,SRK,SRLOC,SRMST,SRNON,SROTH,SRPKG,SRPROV,SRS,SRSC,SRV,SRVSIT,SRX,SRX2
N SRPLSC,SRPLAO,SRPLIR,SRPLEC,SRPLMST,SRPLHNC,SRPLCV,SRPLPRJ,SRADX,SRCNT,SRD,SRDX,SRRPROV,SRUP,SRINOUT,SRO,SRDEPC,SRPFSSAR
N SRDP,SRDC,SRDI,SRDL,SRDIE,SRDG,SRDM,SRDR,SRDH,SRDK,SRDA,SRD0,SRDDER,SRDG,SRDIC,SRDIC1,SRDICRRE,SRDIEDA,SRDIG,SRDIH,SRDIIENS,SRDISL,SRDISYS,SRDIU,SRDIV,SRDIWT,SRDN,SRDQ,SRDX,SRDY
D FM1 K DIC S DIC=9.4,DIC(0)="XM",X="SURGERY" D ^DIC K DIC D FM2 Q:Y=-1 S SRPKG=+Y
S SRS="SURGERY DATA" K ^TMP("SRPXAPI",$J)
D UTIL I 'SRK D PCE
Q
DEL ; delete data from the Visit file and V files
D FM1 K DA,DIE,DR S DA=SRTN,DIE=130,DR=".015///@" D ^DIE K DA,DIE,DR D FM2
D FM1 S SRV=$$DELVFILE^PXAPI("ALL",SRVSIT) K SRVSIT D FM2
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
S SRX=$P($G(^SRF(SRTN,0)),"^",15) 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($G(^SRO(136,SRTN,0)),"^",2) I 'SRCPT S SRK=1 Q
Q:SRK S SRDIAG=$P($G(^SRO(136,SRTN,0)),"^",3) I 'SRDIAG S SRK=1 Q
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(^SRO(136,SRTN,2,SRX)) I SRX="" S SRK=1 Q
S SRX=0 F S SRX=$O(^SRO(136,SRTN,3,SRX)) Q:'SRX S SRX2=0,SRX2=$O(^SRO(136,SRTN,3,SRX,2,SRX2)) I $D(^SRO(136,SRTN,3,SRX,0)),(SRX2="") 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 SRO(0)=$G(^SRO(136,SRTN,0))
S (SRSC,SRAO,SREC,SRHNC,SRIR,SRMST,SRCV,SRPRJ)=0,SRSC=$P(SRO(0),"^",4),SRAO=$P(SRO(0),"^",5),SRIR=$P(SRO(0),"^",6),SREC=$P(SRO(0),"^",7),SRMST=$P(SRO(0),"^",8),SRHNC=$P(SRO(0),"^",9),SRCV=$P(SRO(0),"^",10),SRPRJ=$P(SRO(0),"^",11)
I $$SWSTAT^IBBAPI(),'SRNON D
.S SRX=$P(^SRO(137.45,$P(SR(0),"^",4),0),"^",2)
.I SRX S SRDEPC=$$GET1^DIQ(45.3,SRX,2)
Q
PCE ;
N SRI,SRJ,SRCODE,SROTH D TMP
D2PCE ;
S SRPFSSAR=$P($G(^SRF(SRTN,"PFSS")),"^")
I $$SWSTAT^IBBAPI() D FM1 S SRV=$$DATA2PCE^PXAPI("^TMP(""SRPXAPI"",$J)",SRPKG,SRS,.SRVSIT,,,,,,.SRPFSSAR) D FM2
I '$$SWSTAT^IBBAPI() D FM1 S SRV=$$DATA2PCE^PXAPI("^TMP(""SRPXAPI"",$J)",SRPKG,SRS,.SRVSIT) D FM2
I SRVSIT D FM1 K DA,DIE,DR S DA=SRTN,DIE=130,DR=".015////"_SRVSIT D ^DIE K DA,DIE,DR D FM2
K ^TMP("SRPXAPI",$J),SRVSIT
Q
TMP ;
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
S ^TMP("SRPXAPI",$J,"ENCOUNTER",1,"SHAD")=SRPRJ
PROC S SRI=1,SRCODE=SRCPT D PMOD,CPT
S SROTH=0 F S SROTH=$O(^SRO(136,SRTN,3,SROTH)) Q:'SROTH S SRCODE=$P($G(^SRO(136,SRTN,3,SROTH,0)),"^") I SRCODE S 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")=1
S ^TMP("SRPXAPI",$J,"PROVIDER",1,"PRIMARY")=0
I 'SRNON S ^TMP("SRPXAPI",$J,"PROVIDER",2,"COMMENT")="Attending Surgeon"
DIAG S SRI=1,SRDX=SRDIAG D DX
S SRD=0 F S SRD=$O(^SRO(136,SRTN,4,SRD)) Q:'SRD S SRDX=$P(^SRO(136,SRTN,4,SRD,0),"^") I SRDX D DX
Q
DX S ^TMP("SRPXAPI",$J,"DX/PL",SRI,"DIAGNOSIS")=SRDX
I SRI=1 D
.S ^TMP("SRPXAPI",$J,"DX/PL",1,"PRIMARY")=1
.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
.S ^TMP("SRPXAPI",$J,"DX/PL",1,"PL SHAD")=SRPRJ
I SRI'=1 D
.S SR(4)=$G(^SRO(136,SRTN,4,SRD,0))
.S (SRPLSC,SRPLAO,SRPLIR,SRPLEC,SRPLMST,SRPLHNC,SRPLCV,SRPLPRJ)=0,SRPLSC=$P(SR(4),"^",2),SRPLAO=$P(SR(4),"^",3)
.S SRPLIR=$P(SR(4),"^",4),SRPLMST=$P(SR(4),"^",5),SRPLHNC=$P(SR(4),"^",6),SRPLEC=$P(SR(4),"^",7),SRPLCV=$P(SR(4),"^",8),SRPLPRJ=$P(SR(4),"^",9)
.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
.S ^TMP("SRPXAPI",$J,"DX/PL",SRI,"PL SHAD")=SRPLPRJ
S SRI=SRI+1
Q
CPT S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"ENC PROVIDER")=$S($P($G(^SRF(SRTN,.1)),"^",3)="R":SRATT,1:SRPROV) ;; << *161 RJS
S:SRRPROV'="" ^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,"QTY")=1
S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"COMMENT")=$S(SRI=1:"Principal Procedure",1:"Other Procedure")
I $G(SRDEPC) S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"DEPARTMENT")=SRDEPC
I SRI=1 D
.S SRCNT=1,SRX=0 F S SRX=$O(^SRO(136,SRTN,2,SRX)) Q:'SRX D
..S SRADX=$P(^SRO(136,SRTN,2,SRX,0),"^")
..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(^SRO(136,SRTN,3,SROTH,2,SRX)) Q:'SRX D
..S SRADX=$P(^SRO(136,SRTN,3,SROTH,2,SRX,0),"^")
..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 ;
N SRM,SRMOD,X
S SRM=0 F S SRM=$O(^SRO(136,SRTN,1,SRM)) Q:'SRM S X=$P(^SRO(136,SRTN,1,SRM,0),"^"),SRMOD=$P($$MOD^ICPTMOD(X,"I"),"^",2),^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"MODIFIERS",SRMOD)=""
Q
OMOD ;
N SRM,SRMOD,X
S SRM=0 F S SRM=$O(^SRO(136,SRTN,3,SROTH,1,SRM)) Q:'SRM S X=$P(^SRO(136,SRTN,3,SROTH,1,SRM,0),"^"),SRMOD=$P($$MOD^ICPTMOD(X,"I"),"^",2),^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"MODIFIERS",SRMOD)=""
Q
FM1 M SRDA=DA,SRDP=DP,SRDC=DC,SRDI=DI,SRDL=DL,SRDIE=DIE,SRDG=DG,SRDM=DM,SRDR=DR,SRDH=DH,SRDK=DK,SRD0=D0,SRDDER=DDER,SRDG=DG,SRDIC=DIC,SRDIC1=DIC1,SRDICRRE=DICRREC
M SRDIEDA=DIEDA,SRDIG=DIG,SRDIH=DIH,SRDIIENS=DIIENS,SRDISL=DISL,SRDISYS=DISYS,SRDIU=DIU,SRDIV=DIV,SRDIWT=DIWT,SRDN=DN,SRDQ=DQ,SRDX=DX,SRDY=DY
FM2 M DA=SRDA,DP=SRDP,DC=SRDC,DI=SRDI,DL=SRDL,DIE=SRDIE,DG=SRDG,DM=SRDM,DR=SRDR,DH=SRDH,DK=SRDK,D0=SRD0,DDER=SRDDER,DG=SRDG,DIC=SRDIC,DIC1=SRDIC1,DICRREC=SRDICRRE
M DIEDA=SRDIEDA,DIG=SRDIG,DIH=SRDIH,DIIENS=SRDIIENS,DISL=SRDISL,DISYS=SRDISYS,DIU=SRDIU,DIV=SRDIV,DIWT=SRDIWT,DN=SRDN,DQ=SRDQ,DX=SRDX,DY=SRDY
SROPCEP ;BIR/TJH - PCE UPDATES ;04/26/05 9:28 AM
+1 ;;3.0; Surgery ;**142,152,144,161**;24 Jun 93;Build 5
+2 ;
+3 ; Reference to $$DATA2PCE^PXAPI supported by DBIA #1889
+4 ; Reference to $$DELVFILE^PXAPI supported by DBIA #1890
+5 ; Reference to ^DIC(45.3 is supported by DBIA #218
+6 ;
+7 QUIT
START ; entry for update to PCE with surgery & non-OR procedure data
+1 IF '$DATA(SRTN)
SET SRTN=$GET(DA)
+2 IF SRTN=""
QUIT
+3 NEW DFN,SR,SRAO,SRATT,SRCHK,SRCPT,SRDATE,SRDIAG,SREC,SRHNC,SRIR,SRCV,SRPRJ,SRK,SRLOC,SRMST,SRNON,SROTH,SRPKG,SRPROV,SRS,SRSC,SRV,SRVSIT,SRX,SRX2
+4 NEW SRPLSC,SRPLAO,SRPLIR,SRPLEC,SRPLMST,SRPLHNC,SRPLCV,SRPLPRJ,SRADX,SRCNT,SRD,SRDX,SRRPROV,SRUP,SRINOUT,SRO,SRDEPC,SRPFSSAR
+5 NEW SRDP,SRDC,SRDI,SRDL,SRDIE,SRDG,SRDM,SRDR,SRDH,SRDK,SRDA,SRD0,SRDDER,SRDG,SRDIC,SRDIC1,SRDICRRE,SRDIEDA,SRDIG,SRDIH,SRDIIENS,SRDISL,SRDISYS,SRDIU,SRDIV,SRDIWT,SRDN,SRDQ,SRDX,SRDY
+6 DO FM1
KILL DIC
SET DIC=9.4
SET DIC(0)="XM"
SET X="SURGERY"
DO ^DIC
KILL DIC
DO FM2
IF Y=-1
QUIT
SET SRPKG=+Y
+7 SET SRS="SURGERY DATA"
KILL ^TMP("SRPXAPI",$JOB)
+8 DO UTIL
IF 'SRK
DO PCE
+9 QUIT
DEL ; delete data from the Visit file and V files
+1 DO FM1
KILL DA,DIE,DR
SET DA=SRTN
SET DIE=130
SET DR=".015///@"
DO ^DIE
KILL DA,DIE,DR
DO FM2
+2 DO FM1
SET SRV=$$DELVFILE^PXAPI("ALL",SRVSIT)
KILL SRVSIT
DO FM2
+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 SET SRX=$PIECE($GET(^SRF(SRTN,0)),"^",15)
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($GET(^SRO(136,SRTN,0)),"^",2)
IF 'SRCPT
SET SRK=1
QUIT
+7 IF SRK
QUIT
SET SRDIAG=$PIECE($GET(^SRO(136,SRTN,0)),"^",3)
IF 'SRDIAG
SET SRK=1
QUIT
+8 IF 'SRNON
Begin DoDot:1
+9 SET SRX=$PIECE(SR(0),"^",21)
IF SRX
SET SRLOC=SRX
+10 IF 'SRX
SET SRX=$PIECE(^SRO(137.45,$PIECE(SR(0),"^",4),0),"^",5)
IF SRX
SET SRLOC=SRX
+11 IF 'SRX
SET SRX=$PIECE(SR(0),"^",2)
IF SRX
SET SRLOC=$PIECE(^SRS(SRX,0),"^")
IF 'SRX
SET SRK=1
QUIT
+12 SET SRX=$GET(^SRF(SRTN,.2))
SET SRCHK=$PIECE(SRX,"^",12)
IF 'SRCHK
SET SRK=1
QUIT
+13 SET SRDATE=$PIECE(SRX,"^",10)
IF 'SRDATE
SET SRK=1
QUIT
+14 SET SRX=$GET(^SRF(SRTN,.1))
SET SRPROV=$PIECE(SRX,"^",4)
SET SRATT=$PIECE(SRX,"^",13)
IF 'SRPROV
SET SRK=1
QUIT
+15 IF SRSR'=0
IF 'SRATT
SET SRK=1
QUIT
End DoDot:1
IF SRK
QUIT
+16 IF SRNON
Begin DoDot:1
+17 SET SRLOC=$PIECE(SR(0),"^",21)
+18 SET SRX=^SRF(SRTN,"NON")
SET SRCHK=$PIECE(SRX,"^",5)
IF 'SRCHK
SET SRK=1
QUIT
+19 SET SRDATE=$PIECE(SRX,"^",4)
IF 'SRDATE
SET SRK=1
QUIT
+20 IF 'SRLOC
SET SRLOC=$PIECE(SRX,"^",2)
IF 'SRLOC
SET SRK=1
QUIT
+21 SET SRPROV=$PIECE(SRX,"^",6)
SET SRATT=$PIECE(SRX,"^",7)
IF 'SRPROV
SET SRK=1
+22 IF SRSR'=0
IF 'SRATT
SET SRK=1
End DoDot:1
IF SRK
QUIT
+23 SET VAINDT=SRDATE
+24 DO INP^VADPT
+25 IF VAIN(1)
SET SRINOUT="I"
+26 IF 'VAIN(1)
SET SRINOUT="O"
+27 KILL VAINDT,VAIN
+28 IF '$$CLINIC^SROUTL(SRLOC,SRTN)
SET SRK=1
QUIT
+29 SET SRX=0
SET SRX=$ORDER(^SRO(136,SRTN,2,SRX))
IF SRX=""
SET SRK=1
QUIT
+30 SET SRX=0
FOR
SET SRX=$ORDER(^SRO(136,SRTN,3,SRX))
IF 'SRX
QUIT
SET SRX2=0
SET SRX2=$ORDER(^SRO(136,SRTN,3,SRX,2,SRX2))
IF $DATA(^SRO(136,SRTN,3,SRX,0))
IF (SRX2="")
SET SRK=1
IF SRK
QUIT
+31 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)
+32 SET SRO(0)=$GET(^SRO(136,SRTN,0))
+33 SET (SRSC,SRAO,SREC,SRHNC,SRIR,SRMST,SRCV,SRPRJ)=0
SET SRSC=$PIECE(SRO(0),"^",4)
SET SRAO=$PIECE(SRO(0),"^",5)
SET SRIR=$PIECE(SRO(0),"^",6)
SET SREC=$PIECE(SRO(0),"^",7)
SET SRMST=$PIECE(SRO(0),"^",8)
SET SRHNC=$PIECE(SRO(0),"^",9)
SET SRCV=$PIECE(SRO(0),"^",10)
SET SRPRJ=$PIECE(SRO(0),"^",11)
+34 IF $$SWSTAT^IBBAPI()
IF 'SRNON
Begin DoDot:1
+35 SET SRX=$PIECE(^SRO(137.45,$PIECE(SR(0),"^",4),0),"^",2)
+36 IF SRX
SET SRDEPC=$$GET1^DIQ(45.3,SRX,2)
End DoDot:1
+37 QUIT
PCE ;
+1 NEW SRI,SRJ,SRCODE,SROTH
DO TMP
D2PCE ;
+1 SET SRPFSSAR=$PIECE($GET(^SRF(SRTN,"PFSS")),"^")
+2 IF $$SWSTAT^IBBAPI()
DO FM1
SET SRV=$$DATA2PCE^PXAPI("^TMP(""SRPXAPI"",$J)",SRPKG,SRS,.SRVSIT,,,,,,.SRPFSSAR)
DO FM2
+3 IF '$$SWSTAT^IBBAPI()
DO FM1
SET SRV=$$DATA2PCE^PXAPI("^TMP(""SRPXAPI"",$J)",SRPKG,SRS,.SRVSIT)
DO FM2
+4 IF SRVSIT
DO FM1
KILL DA,DIE,DR
SET DA=SRTN
SET DIE=130
SET DR=".015////"_SRVSIT
DO ^DIE
KILL DA,DIE,DR
DO FM2
+5 KILL ^TMP("SRPXAPI",$JOB),SRVSIT
+6 QUIT
TMP ;
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
+14 SET ^TMP("SRPXAPI",$JOB,"ENCOUNTER",1,"SHAD")=SRPRJ
PROC SET SRI=1
SET SRCODE=SRCPT
DO PMOD
DO CPT
+1 SET SROTH=0
FOR
SET SROTH=$ORDER(^SRO(136,SRTN,3,SROTH))
IF 'SROTH
QUIT
SET SRCODE=$PIECE($GET(^SRO(136,SRTN,3,SROTH,0)),"^")
IF SRCODE
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")=1
+8 SET ^TMP("SRPXAPI",$JOB,"PROVIDER",1,"PRIMARY")=0
+9 IF 'SRNON
SET ^TMP("SRPXAPI",$JOB,"PROVIDER",2,"COMMENT")="Attending Surgeon"
DIAG SET SRI=1
SET SRDX=SRDIAG
DO DX
+1 SET SRD=0
FOR
SET SRD=$ORDER(^SRO(136,SRTN,4,SRD))
IF 'SRD
QUIT
SET SRDX=$PIECE(^SRO(136,SRTN,4,SRD,0),"^")
IF SRDX
DO DX
+2 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 SET ^TMP("SRPXAPI",$JOB,"DX/PL",1,"ORD/RES")="R"
+4 SET ^TMP("SRPXAPI",$JOB,"DX/PL",1,"PL SC")=SRSC
+5 SET ^TMP("SRPXAPI",$JOB,"DX/PL",1,"PL AO")=SRAO
+6 SET ^TMP("SRPXAPI",$JOB,"DX/PL",1,"PL IR")=SRIR
+7 SET ^TMP("SRPXAPI",$JOB,"DX/PL",1,"PL EC")=SREC
+8 SET ^TMP("SRPXAPI",$JOB,"DX/PL",1,"PL MST")=SRMST
+9 SET ^TMP("SRPXAPI",$JOB,"DX/PL",1,"PL HNC")=SRHNC
+10 SET ^TMP("SRPXAPI",$JOB,"DX/PL",1,"PL CV")=SRCV
+11 SET ^TMP("SRPXAPI",$JOB,"DX/PL",1,"PL SHAD")=SRPRJ
End DoDot:1
+12 IF SRI'=1
Begin DoDot:1
+13 SET SR(4)=$GET(^SRO(136,SRTN,4,SRD,0))
+14 SET (SRPLSC,SRPLAO,SRPLIR,SRPLEC,SRPLMST,SRPLHNC,SRPLCV,SRPLPRJ)=0
SET SRPLSC=$PIECE(SR(4),"^",2)
SET SRPLAO=$PIECE(SR(4),"^",3)
+15 SET SRPLIR=$PIECE(SR(4),"^",4)
SET SRPLMST=$PIECE(SR(4),"^",5)
SET SRPLHNC=$PIECE(SR(4),"^",6)
SET SRPLEC=$PIECE(SR(4),"^",7)
SET SRPLCV=$PIECE(SR(4),"^",8)
SET SRPLPRJ=$PIECE(SR(4),"^",9)
+16 SET ^TMP("SRPXAPI",$JOB,"DX/PL",SRI,"ORD/RES")="R"
+17 SET ^TMP("SRPXAPI",$JOB,"DX/PL",SRI,"PL SC")=SRPLSC
+18 SET ^TMP("SRPXAPI",$JOB,"DX/PL",SRI,"PL AO")=SRPLAO
+19 SET ^TMP("SRPXAPI",$JOB,"DX/PL",SRI,"PL IR")=SRPLIR
+20 SET ^TMP("SRPXAPI",$JOB,"DX/PL",SRI,"PL EC")=SRPLEC
+21 SET ^TMP("SRPXAPI",$JOB,"DX/PL",SRI,"PL MST")=SRPLMST
+22 SET ^TMP("SRPXAPI",$JOB,"DX/PL",SRI,"PL HNC")=SRPLHNC
+23 SET ^TMP("SRPXAPI",$JOB,"DX/PL",SRI,"PL CV")=SRPLCV
+24 SET ^TMP("SRPXAPI",$JOB,"DX/PL",SRI,"PL SHAD")=SRPLPRJ
End DoDot:1
+25 SET SRI=SRI+1
+26 QUIT
CPT ;; << *161 RJS
SET ^TMP("SRPXAPI",$JOB,"PROCEDURE",SRI,"ENC PROVIDER")=$SELECT($PIECE($GET(^SRF(SRTN,.1)),"^",3)="R":SRATT,1:SRPROV)
+1 IF SRRPROV'=""
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,"QTY")=1
+5 SET ^TMP("SRPXAPI",$JOB,"PROCEDURE",SRI,"COMMENT")=$SELECT(SRI=1:"Principal Procedure",1:"Other Procedure")
+6 IF $GET(SRDEPC)
SET ^TMP("SRPXAPI",$JOB,"PROCEDURE",SRI,"DEPARTMENT")=SRDEPC
+7 IF SRI=1
Begin DoDot:1
+8 SET SRCNT=1
SET SRX=0
FOR
SET SRX=$ORDER(^SRO(136,SRTN,2,SRX))
IF 'SRX
QUIT
Begin DoDot:2
+9 SET SRADX=$PIECE(^SRO(136,SRTN,2,SRX,0),"^")
+10 IF SRCNT=1
SET ^TMP("SRPXAPI",$JOB,"PROCEDURE",1,"DIAGNOSIS")=SRADX
+11 IF SRCNT=2
SET ^TMP("SRPXAPI",$JOB,"PROCEDURE",1,"DIAGNOSIS 2")=SRADX
+12 IF SRCNT=3
SET ^TMP("SRPXAPI",$JOB,"PROCEDURE",1,"DIAGNOSIS 3")=SRADX
+13 IF SRCNT=4
SET ^TMP("SRPXAPI",$JOB,"PROCEDURE",1,"DIAGNOSIS 4")=SRADX
+14 IF SRCNT=5
SET ^TMP("SRPXAPI",$JOB,"PROCEDURE",1,"DIAGNOSIS 5")=SRADX
+15 IF SRCNT=6
SET ^TMP("SRPXAPI",$JOB,"PROCEDURE",1,"DIAGNOSIS 6")=SRADX
+16 IF SRCNT=7
SET ^TMP("SRPXAPI",$JOB,"PROCEDURE",1,"DIAGNOSIS 7")=SRADX
+17 IF SRCNT=8
SET ^TMP("SRPXAPI",$JOB,"PROCEDURE",1,"DIAGNOSIS 8")=SRADX
+18 SET SRCNT=SRCNT+1
End DoDot:2
End DoDot:1
+19 IF SRI'=1
Begin DoDot:1
+20 SET SRCNT=1
SET SRX=0
FOR
SET SRX=$ORDER(^SRO(136,SRTN,3,SROTH,2,SRX))
IF 'SRX
QUIT
Begin DoDot:2
+21 SET SRADX=$PIECE(^SRO(136,SRTN,3,SROTH,2,SRX,0),"^")
+22 IF SRCNT=1
SET ^TMP("SRPXAPI",$JOB,"PROCEDURE",SRI,"DIAGNOSIS")=SRADX
+23 IF SRCNT=2
SET ^TMP("SRPXAPI",$JOB,"PROCEDURE",SRI,"DIAGNOSIS 2")=SRADX
+24 IF SRCNT=3
SET ^TMP("SRPXAPI",$JOB,"PROCEDURE",SRI,"DIAGNOSIS 3")=SRADX
+25 IF SRCNT=4
SET ^TMP("SRPXAPI",$JOB,"PROCEDURE",SRI,"DIAGNOSIS 4")=SRADX
+26 IF SRCNT=5
SET ^TMP("SRPXAPI",$JOB,"PROCEDURE",SRI,"DIAGNOSIS 5")=SRADX
+27 IF SRCNT=6
SET ^TMP("SRPXAPI",$JOB,"PROCEDURE",SRI,"DIAGNOSIS 6")=SRADX
+28 IF SRCNT=7
SET ^TMP("SRPXAPI",$JOB,"PROCEDURE",SRI,"DIAGNOSIS 7")=SRADX
+29 IF SRCNT=8
SET ^TMP("SRPXAPI",$JOB,"PROCEDURE",SRI,"DIAGNOSIS 8")=SRADX
+30 SET SRCNT=SRCNT+1
End DoDot:2
End DoDot:1
+31 QUIT
PMOD ;
+1 NEW SRM,SRMOD,X
+2 SET SRM=0
FOR
SET SRM=$ORDER(^SRO(136,SRTN,1,SRM))
IF 'SRM
QUIT
SET X=$PIECE(^SRO(136,SRTN,1,SRM,0),"^")
SET SRMOD=$PIECE($$MOD^ICPTMOD(X,"I"),"^",2)
SET ^TMP("SRPXAPI",$JOB,"PROCEDURE",SRI,"MODIFIERS",SRMOD)=""
+3 QUIT
OMOD ;
+1 NEW SRM,SRMOD,X
+2 SET SRM=0
FOR
SET SRM=$ORDER(^SRO(136,SRTN,3,SROTH,1,SRM))
IF 'SRM
QUIT
SET X=$PIECE(^SRO(136,SRTN,3,SROTH,1,SRM,0),"^")
SET SRMOD=$PIECE($$MOD^ICPTMOD(X,"I"),"^",2)
SET ^TMP("SRPXAPI",$JOB,"PROCEDURE",SRI,"MODIFIERS",SRMOD)=""
+3 QUIT
FM1 MERGE SRDA=DA,SRDP=DP,SRDC=DC,SRDI=DI,SRDL=DL,SRDIE=DIE,SRDG=DG,SRDM=DM,SRDR=DR,SRDH=DH,SRDK=DK,SRD0=D0,SRDDER=DDER,SRDG=DG,SRDIC=DIC,SRDIC1=DIC1,SRDICRRE=DICRREC
+1 MERGE SRDIEDA=DIEDA,SRDIG=DIG,SRDIH=DIH,SRDIIENS=DIIENS,SRDISL=DISL,SRDISYS=DISYS,SRDIU=DIU,SRDIV=DIV,SRDIWT=DIWT,SRDN=DN,SRDQ=DQ,SRDX=DX,SRDY=DY
FM2 MERGE DA=SRDA,DP=SRDP,DC=SRDC,DI=SRDI,DL=SRDL,DIE=SRDIE,DG=SRDG,DM=SRDM,DR=SRDR,DH=SRDH,DK=SRDK,D0=SRD0,DDER=SRDDER,DG=SRDG,DIC=SRDIC,DIC1=SRDIC1,DICRREC=SRDICRRE
+1 MERGE DIEDA=SRDIEDA,DIG=SRDIG,DIH=SRDIH,DIIENS=SRDIIENS,DISL=SRDISL,DISYS=SRDISYS,DIU=SRDIU,DIV=SRDIV,DIWT=SRDIWT,DN=SRDN,DQ=SRDQ,DX=SRDX,DY=SRDY
