| [613] | 1 | SROPFSS ;BIR/SJA - Surgery/IBB GETACCOUNT API ;01/13/05  9:31 AM
 | 
|---|
 | 2 |  ;;3.0; Surgery ;**144**;24 Jun 93
 | 
|---|
 | 3 |  ;
 | 
|---|
 | 4 |  ; Reference to $$GETACCT^IBBAPI is supported by DBIA #4664
 | 
|---|
 | 5 |  ; Reference to ^DIC(40.7 is supported by DBIA #557
 | 
|---|
 | 6 |  ; Reference to ^DG(40.8 is supported by DBIA #2817
 | 
|---|
 | 7 |  ;
 | 
|---|
 | 8 | SERR(SRCASE,SRY) ; entry point for routine SROERR & SROERR0.
 | 
|---|
 | 9 |  I 'SRCASE!('+$$SWSTAT^IBBAPI())!($P($G(^SRF(SRCASE,"NON")),"^")="Y") K ^TMP("SRPFSS",$J) Q
 | 
|---|
 | 10 |  S SROP=SRCASE,SROPER="" D ^SROP1
 | 
|---|
 | 11 |  N SRCARFN,SRAPLR,SRDFN,SRDG1,SRDIV,SRGETACC,SRII,SRNODE0,SRPR1,SRPV1,SRPV2,SRRARFN,SRLSS,SRLSSC,SRSURG,SRTMP,SRTP,SRX
 | 
|---|
 | 12 |  S SRTP="",SRGETACC=$P($G(^SRF(SRCASE,"PFSS")),"^"),SRTMP=$D(^TMP("SRPFSS",$J)) D
 | 
|---|
 | 13 |  .I SRY="SROERR0" D
 | 
|---|
 | 14 |  ..I SROPER["(REQUESTED)",SRTMP S SRTP=$S(SRGETACC&$D(SRSCHST):"A11",SRGETACC:"A08",'SRGETACC:"A04",1:"") Q
 | 
|---|
 | 15 |  ..I SROPER["(SCHEDULED)"!(SROPER["(NOT COMPLETE)")!(SROPER["(COMPLETED)"),SRTMP S SRTP=$S('SRGETACC:"A04",1:"A08") Q
 | 
|---|
 | 16 |  ..I SROPER["(CANCELLED)",SRGETACC S SRTP="A11" Q
 | 
|---|
 | 17 |  .I SRY="SROERR" D
 | 
|---|
 | 18 |  ..I SROPER["(SCHEDULED)" S SRTP=$S('SRGETACC:"A04",1:"A08") Q
 | 
|---|
 | 19 |  ..I SROPER["(REQUESTED)" S SRTP=$S(SRGETACC:"A08",'SRGETACC:"A04",1:"") Q
 | 
|---|
 | 20 |  ..I SROPER["NOT COMPLETE",'SRGETACC,SRTMP S SRTP="A04" Q  ;New case
 | 
|---|
 | 21 |  ;;;I SRY["DEL"!(SROPER["CANCELLED")!(SROPER["ABORTED") S SRTP="A11" ;cancel
 | 
|---|
 | 22 | ST K ^TMP("SRPFSS",$J) I SRTP']"" Q
 | 
|---|
 | 23 |  S SRNODE0=$G(^SRF(SRCASE,0))
 | 
|---|
 | 24 |  S SRDFN=$S($D(DFN):DFN,1:$P(SRNODE0,"^")) ;Patient ID (DFN)
 | 
|---|
 | 25 |  S SRRARFN=$S((SRTP="A11"!(SRTP="A08")):SRGETACC,1:"") ;Account Reference Number 
 | 
|---|
 | 26 |  S SRLSSC=+$P(SRNODE0,"^",4),SRLSS=$G(^SRO(137.45,SRLSSC,0))
 | 
|---|
 | 27 |  S SRPV1(2)=$S($P(SRNODE0,"^",12)="I":"I",1:"O") ;Patient Class; I(npatient) or O(utpatient)
 | 
|---|
 | 28 |  S SRPV1(3)=$S($P(SRNODE0,"^",21)]"":$P(SRNODE0,"^",21),1:$P(SRLSS,"^",5)) ;Patient Location
 | 
|---|
 | 29 |  S SRPV1(7)=$P($G(^SRF(SRCASE,.1)),"^",13) ;Attending Surgeon
 | 
|---|
 | 30 |  S (SRPR1(11),SRPV1(17))=$P($G(^SRF(SRCASE,.1)),"^",4) ;Surgeon
 | 
|---|
 | 31 |  S SRPV1(18)=$O(^DIC(40.7,"C",429,0))
 | 
|---|
 | 32 |  S (SRPV1(44),SRPV2(8))=$P(SRNODE0,"^",9) ;Admit Date/Time
 | 
|---|
 | 33 |  S SRPR1(4)=$E($P(^SRF(SRCASE,"OP"),"^"),1,60) ;Principal Procedure (free text)
 | 
|---|
 | 34 |  S SRSURG(1)=SRCASE
 | 
|---|
 | 35 |  S SRSURG(2)=$P(SRLSS,"^",2)
 | 
|---|
 | 36 |  S SRDG1(1,4)=$E($P($G(^SRF(SRCASE,33)),"^"),1,40) ;Principal Pre-Op Diagnosis
 | 
|---|
 | 37 |  S SRII=$P($G(^SRF(SRCASE,8)),"^"),SRDIV=$O(^DG(40.8,"AD",SRII,0)) ;Medical Center Division/Facility
 | 
|---|
 | 38 |  S SRAPLR=$S(SRTP="A04":"ACCT;SROPFSS",1:"")
 | 
|---|
 | 39 |  ;
 | 
|---|
 | 40 | ACCT ; Call IBB GETACCOUNT API to get a new Account Reference Number
 | 
|---|
 | 41 |  S SRCARFN=+$$GETACCT^IBBAPI(SRDFN,SRRARFN,SRTP,SRAPLR,.SRPV1,.SRPV2,.SRPR1,.SRDG1,"",SRDIV,"",.SRSURG)
 | 
|---|
 | 42 |  I $G(SRCARFN) S $P(^SRF(SRCASE,"PFSS"),"^")=SRCARFN
 | 
|---|
 | 43 | EXIT K SRCARFN
 | 
|---|
 | 44 |  Q
 | 
|---|