Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SROPCEP

SROPCEP.m

Go to the documentation of this file.
  1. SROPCEP ;BIR/TJH - PCE UPDATES ;04/26/05 9:28 AM
  1. ;;3.0; Surgery ;**142,152,144,161**;24 Jun 93;Build 5
  1. ;
  1. ; Reference to $$DATA2PCE^PXAPI supported by DBIA #1889
  1. ; Reference to $$DELVFILE^PXAPI supported by DBIA #1890
  1. ; Reference to ^DIC(45.3 is supported by DBIA #218
  1. ;
  1. Q
  1. START ; entry for update to PCE with surgery & non-OR procedure data
  1. I '$D(SRTN) S SRTN=$G(DA)
  1. I SRTN="" Q
  1. 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
  1. N SRPLSC,SRPLAO,SRPLIR,SRPLEC,SRPLMST,SRPLHNC,SRPLCV,SRPLPRJ,SRADX,SRCNT,SRD,SRDX,SRRPROV,SRUP,SRINOUT,SRO,SRDEPC,SRPFSSAR
  1. 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
  1. 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
  1. S SRS="SURGERY DATA" K ^TMP("SRPXAPI",$J)
  1. D UTIL I 'SRK D PCE
  1. Q
  1. DEL ; delete data from the Visit file and V files
  1. D FM1 K DA,DIE,DR S DA=SRTN,DIE=130,DR=".015///@" D ^DIE K DA,DIE,DR D FM2
  1. D FM1 S SRV=$$DELVFILE^PXAPI("ALL",SRVSIT) K SRVSIT D FM2
  1. Q
  1. UTIL ; set procedure variables
  1. N SRDIV,SRSITE,SRSR
  1. 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
  1. S SRX=$P($G(^SRF(SRTN,0)),"^",15) I SRX S SRVSIT=SRX D DEL I '$D(^SRF(SRTN,0)) S SRK=1 Q
  1. S SR(0)=$G(^SRF(SRTN,0)) I SR(0)=""!$P($G(^SRF(SRTN,30)),"^") S SRK=1 Q
  1. S DFN=$P(SR(0),"^")
  1. 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
  1. Q:SRK S SRDIAG=$P($G(^SRO(136,SRTN,0)),"^",3) I 'SRDIAG S SRK=1 Q
  1. I 'SRNON D I SRK Q
  1. .S SRX=$P(SR(0),"^",21) I SRX S SRLOC=SRX
  1. .I 'SRX S SRX=$P(^SRO(137.45,$P(SR(0),"^",4),0),"^",5) I SRX S SRLOC=SRX
  1. .I 'SRX S SRX=$P(SR(0),"^",2) S:SRX SRLOC=$P(^SRS(SRX,0),"^") I 'SRX S SRK=1 Q
  1. .S SRX=$G(^SRF(SRTN,.2)),SRCHK=$P(SRX,"^",12) I 'SRCHK S SRK=1 Q
  1. .S SRDATE=$P(SRX,"^",10) I 'SRDATE S SRK=1 Q
  1. .S SRX=$G(^SRF(SRTN,.1)),SRPROV=$P(SRX,"^",4),SRATT=$P(SRX,"^",13) I 'SRPROV S SRK=1 Q
  1. .I SRSR'=0,'SRATT S SRK=1 Q
  1. I SRNON D I SRK Q
  1. .S SRLOC=$P(SR(0),"^",21)
  1. .S SRX=^SRF(SRTN,"NON"),SRCHK=$P(SRX,"^",5) I 'SRCHK S SRK=1 Q
  1. .S SRDATE=$P(SRX,"^",4) I 'SRDATE S SRK=1 Q
  1. .I 'SRLOC S SRLOC=$P(SRX,"^",2) I 'SRLOC S SRK=1 Q
  1. .S SRPROV=$P(SRX,"^",6),SRATT=$P(SRX,"^",7) I 'SRPROV S SRK=1
  1. .I SRSR'=0,'SRATT S SRK=1
  1. S VAINDT=SRDATE
  1. D INP^VADPT
  1. I VAIN(1) S SRINOUT="I"
  1. I 'VAIN(1) S SRINOUT="O"
  1. K VAINDT,VAIN
  1. I '$$CLINIC^SROUTL(SRLOC,SRTN) S SRK=1 Q
  1. S SRX=0,SRX=$O(^SRO(136,SRTN,2,SRX)) I SRX="" S SRK=1 Q
  1. 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
  1. 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)
  1. S SRO(0)=$G(^SRO(136,SRTN,0))
  1. 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)
  1. I $$SWSTAT^IBBAPI(),'SRNON D
  1. .S SRX=$P(^SRO(137.45,$P(SR(0),"^",4),0),"^",2)
  1. .I SRX S SRDEPC=$$GET1^DIQ(45.3,SRX,2)
  1. Q
  1. PCE ;
  1. N SRI,SRJ,SRCODE,SROTH D TMP
  1. D2PCE ;
  1. S SRPFSSAR=$P($G(^SRF(SRTN,"PFSS")),"^")
  1. I $$SWSTAT^IBBAPI() D FM1 S SRV=$$DATA2PCE^PXAPI("^TMP(""SRPXAPI"",$J)",SRPKG,SRS,.SRVSIT,,,,,,.SRPFSSAR) D FM2
  1. I '$$SWSTAT^IBBAPI() D FM1 S SRV=$$DATA2PCE^PXAPI("^TMP(""SRPXAPI"",$J)",SRPKG,SRS,.SRVSIT) D FM2
  1. I SRVSIT D FM1 K DA,DIE,DR S DA=SRTN,DIE=130,DR=".015////"_SRVSIT D ^DIE K DA,DIE,DR D FM2
  1. K ^TMP("SRPXAPI",$J),SRVSIT
  1. Q
  1. TMP ;
  1. ENC S ^TMP("SRPXAPI",$J,"ENCOUNTER",1,"ENC D/T")=SRDATE
  1. S ^TMP("SRPXAPI",$J,"ENCOUNTER",1,"PATIENT")=DFN
  1. S ^TMP("SRPXAPI",$J,"ENCOUNTER",1,"HOS LOC")=SRLOC
  1. S ^TMP("SRPXAPI",$J,"ENCOUNTER",1,"CHECKOUT D/T")=SRCHK
  1. S ^TMP("SRPXAPI",$J,"ENCOUNTER",1,"SERVICE CATEGORY")="S"
  1. S ^TMP("SRPXAPI",$J,"ENCOUNTER",1,"ENCOUNTER TYPE")="P"
  1. S ^TMP("SRPXAPI",$J,"ENCOUNTER",1,"APPT")=9
  1. S ^TMP("SRPXAPI",$J,"ENCOUNTER",1,"SC")=SRSC
  1. S ^TMP("SRPXAPI",$J,"ENCOUNTER",1,"AO")=SRAO
  1. S ^TMP("SRPXAPI",$J,"ENCOUNTER",1,"IR")=SRIR
  1. S ^TMP("SRPXAPI",$J,"ENCOUNTER",1,"EC")=SREC
  1. S ^TMP("SRPXAPI",$J,"ENCOUNTER",1,"MST")=SRMST
  1. S ^TMP("SRPXAPI",$J,"ENCOUNTER",1,"HNC")=SRHNC
  1. S ^TMP("SRPXAPI",$J,"ENCOUNTER",1,"CV")=SRCV
  1. S ^TMP("SRPXAPI",$J,"ENCOUNTER",1,"SHAD")=SRPRJ
  1. PROC S SRI=1,SRCODE=SRCPT D PMOD,CPT
  1. 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
  1. PROV S ^TMP("SRPXAPI",$J,"PROVIDER",1,"NAME")=SRPROV
  1. S ^TMP("SRPXAPI",$J,"PROVIDER",1,"PRIMARY")=1
  1. I 'SRNON S ^TMP("SRPXAPI",$J,"PROVIDER",1,"COMMENT")="Surgeon"
  1. I SRPROV=SRATT!'SRATT S ^TMP("SRPXAPI",$J,"PROVIDER",1,"ATTENDING")=1 G DIAG
  1. I 'SRATT G DIAG
  1. S ^TMP("SRPXAPI",$J,"PROVIDER",2,"NAME")=SRATT
  1. S ^TMP("SRPXAPI",$J,"PROVIDER",2,"ATTENDING")=1
  1. S ^TMP("SRPXAPI",$J,"PROVIDER",2,"PRIMARY")=1
  1. S ^TMP("SRPXAPI",$J,"PROVIDER",1,"PRIMARY")=0
  1. I 'SRNON S ^TMP("SRPXAPI",$J,"PROVIDER",2,"COMMENT")="Attending Surgeon"
  1. DIAG S SRI=1,SRDX=SRDIAG D DX
  1. 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
  1. Q
  1. DX S ^TMP("SRPXAPI",$J,"DX/PL",SRI,"DIAGNOSIS")=SRDX
  1. I SRI=1 D
  1. .S ^TMP("SRPXAPI",$J,"DX/PL",1,"PRIMARY")=1
  1. .S ^TMP("SRPXAPI",$J,"DX/PL",1,"ORD/RES")="R"
  1. .S ^TMP("SRPXAPI",$J,"DX/PL",1,"PL SC")=SRSC
  1. .S ^TMP("SRPXAPI",$J,"DX/PL",1,"PL AO")=SRAO
  1. .S ^TMP("SRPXAPI",$J,"DX/PL",1,"PL IR")=SRIR
  1. .S ^TMP("SRPXAPI",$J,"DX/PL",1,"PL EC")=SREC
  1. .S ^TMP("SRPXAPI",$J,"DX/PL",1,"PL MST")=SRMST
  1. .S ^TMP("SRPXAPI",$J,"DX/PL",1,"PL HNC")=SRHNC
  1. .S ^TMP("SRPXAPI",$J,"DX/PL",1,"PL CV")=SRCV
  1. .S ^TMP("SRPXAPI",$J,"DX/PL",1,"PL SHAD")=SRPRJ
  1. I SRI'=1 D
  1. .S SR(4)=$G(^SRO(136,SRTN,4,SRD,0))
  1. .S (SRPLSC,SRPLAO,SRPLIR,SRPLEC,SRPLMST,SRPLHNC,SRPLCV,SRPLPRJ)=0,SRPLSC=$P(SR(4),"^",2),SRPLAO=$P(SR(4),"^",3)
  1. .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)
  1. .S ^TMP("SRPXAPI",$J,"DX/PL",SRI,"ORD/RES")="R"
  1. .S ^TMP("SRPXAPI",$J,"DX/PL",SRI,"PL SC")=SRPLSC
  1. .S ^TMP("SRPXAPI",$J,"DX/PL",SRI,"PL AO")=SRPLAO
  1. .S ^TMP("SRPXAPI",$J,"DX/PL",SRI,"PL IR")=SRPLIR
  1. .S ^TMP("SRPXAPI",$J,"DX/PL",SRI,"PL EC")=SRPLEC
  1. .S ^TMP("SRPXAPI",$J,"DX/PL",SRI,"PL MST")=SRPLMST
  1. .S ^TMP("SRPXAPI",$J,"DX/PL",SRI,"PL HNC")=SRPLHNC
  1. .S ^TMP("SRPXAPI",$J,"DX/PL",SRI,"PL CV")=SRPLCV
  1. .S ^TMP("SRPXAPI",$J,"DX/PL",SRI,"PL SHAD")=SRPLPRJ
  1. S SRI=SRI+1
  1. Q
  1. CPT S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"ENC PROVIDER")=$S($P($G(^SRF(SRTN,.1)),"^",3)="R":SRATT,1:SRPROV) ;; << *161 RJS
  1. S:SRRPROV'="" ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"ORD PROVIDER")=SRRPROV
  1. S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"EVENT D/T")=SRDATE
  1. S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"PROCEDURE")=SRCODE
  1. S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"QTY")=1
  1. S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"COMMENT")=$S(SRI=1:"Principal Procedure",1:"Other Procedure")
  1. I $G(SRDEPC) S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"DEPARTMENT")=SRDEPC
  1. I SRI=1 D
  1. .S SRCNT=1,SRX=0 F S SRX=$O(^SRO(136,SRTN,2,SRX)) Q:'SRX D
  1. ..S SRADX=$P(^SRO(136,SRTN,2,SRX,0),"^")
  1. ..I SRCNT=1 S ^TMP("SRPXAPI",$J,"PROCEDURE",1,"DIAGNOSIS")=SRADX
  1. ..I SRCNT=2 S ^TMP("SRPXAPI",$J,"PROCEDURE",1,"DIAGNOSIS 2")=SRADX
  1. ..I SRCNT=3 S ^TMP("SRPXAPI",$J,"PROCEDURE",1,"DIAGNOSIS 3")=SRADX
  1. ..I SRCNT=4 S ^TMP("SRPXAPI",$J,"PROCEDURE",1,"DIAGNOSIS 4")=SRADX
  1. ..I SRCNT=5 S ^TMP("SRPXAPI",$J,"PROCEDURE",1,"DIAGNOSIS 5")=SRADX
  1. ..I SRCNT=6 S ^TMP("SRPXAPI",$J,"PROCEDURE",1,"DIAGNOSIS 6")=SRADX
  1. ..I SRCNT=7 S ^TMP("SRPXAPI",$J,"PROCEDURE",1,"DIAGNOSIS 7")=SRADX
  1. ..I SRCNT=8 S ^TMP("SRPXAPI",$J,"PROCEDURE",1,"DIAGNOSIS 8")=SRADX
  1. ..S SRCNT=SRCNT+1
  1. I SRI'=1 D
  1. .S SRCNT=1,SRX=0 F S SRX=$O(^SRO(136,SRTN,3,SROTH,2,SRX)) Q:'SRX D
  1. ..S SRADX=$P(^SRO(136,SRTN,3,SROTH,2,SRX,0),"^")
  1. ..I SRCNT=1 S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"DIAGNOSIS")=SRADX
  1. ..I SRCNT=2 S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"DIAGNOSIS 2")=SRADX
  1. ..I SRCNT=3 S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"DIAGNOSIS 3")=SRADX
  1. ..I SRCNT=4 S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"DIAGNOSIS 4")=SRADX
  1. ..I SRCNT=5 S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"DIAGNOSIS 5")=SRADX
  1. ..I SRCNT=6 S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"DIAGNOSIS 6")=SRADX
  1. ..I SRCNT=7 S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"DIAGNOSIS 7")=SRADX
  1. ..I SRCNT=8 S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"DIAGNOSIS 8")=SRADX
  1. ..S SRCNT=SRCNT+1
  1. Q
  1. PMOD ;
  1. N SRM,SRMOD,X
  1. 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)=""
  1. Q
  1. OMOD ;
  1. N SRM,SRMOD,X
  1. 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)=""
  1. Q
  1. 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
  1. 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
  1. 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
  1. 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