- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROPCEP 9805 printed Jan 18, 2025@03:46:06 Page 2
- 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