- SROPFSS ;BIR/SJA - Surgery/IBB GETACCOUNT API ;01/13/05 9:31 AM
- ;;3.0; Surgery ;**144**;24 Jun 93
- ;
- ; Reference to $$GETACCT^IBBAPI is supported by DBIA #4664
- ; Reference to ^DIC(40.7 is supported by DBIA #557
- ; Reference to ^DG(40.8 is supported by DBIA #2817
- ;
- SERR(SRCASE,SRY) ; entry point for routine SROERR & SROERR0.
- I 'SRCASE!('+$$SWSTAT^IBBAPI())!($P($G(^SRF(SRCASE,"NON")),"^")="Y") K ^TMP("SRPFSS",$J) Q
- S SROP=SRCASE,SROPER="" D ^SROP1
- N SRCARFN,SRAPLR,SRDFN,SRDG1,SRDIV,SRGETACC,SRII,SRNODE0,SRPR1,SRPV1,SRPV2,SRRARFN,SRLSS,SRLSSC,SRSURG,SRTMP,SRTP,SRX
- S SRTP="",SRGETACC=$P($G(^SRF(SRCASE,"PFSS")),"^"),SRTMP=$D(^TMP("SRPFSS",$J)) D
- .I SRY="SROERR0" D
- ..I SROPER["(REQUESTED)",SRTMP S SRTP=$S(SRGETACC&$D(SRSCHST):"A11",SRGETACC:"A08",'SRGETACC:"A04",1:"") Q
- ..I SROPER["(SCHEDULED)"!(SROPER["(NOT COMPLETE)")!(SROPER["(COMPLETED)"),SRTMP S SRTP=$S('SRGETACC:"A04",1:"A08") Q
- ..I SROPER["(CANCELLED)",SRGETACC S SRTP="A11" Q
- .I SRY="SROERR" D
- ..I SROPER["(SCHEDULED)" S SRTP=$S('SRGETACC:"A04",1:"A08") Q
- ..I SROPER["(REQUESTED)" S SRTP=$S(SRGETACC:"A08",'SRGETACC:"A04",1:"") Q
- ..I SROPER["NOT COMPLETE",'SRGETACC,SRTMP S SRTP="A04" Q ;New case
- ;;;I SRY["DEL"!(SROPER["CANCELLED")!(SROPER["ABORTED") S SRTP="A11" ;cancel
- ST K ^TMP("SRPFSS",$J) I SRTP']"" Q
- S SRNODE0=$G(^SRF(SRCASE,0))
- S SRDFN=$S($D(DFN):DFN,1:$P(SRNODE0,"^")) ;Patient ID (DFN)
- S SRRARFN=$S((SRTP="A11"!(SRTP="A08")):SRGETACC,1:"") ;Account Reference Number
- S SRLSSC=+$P(SRNODE0,"^",4),SRLSS=$G(^SRO(137.45,SRLSSC,0))
- S SRPV1(2)=$S($P(SRNODE0,"^",12)="I":"I",1:"O") ;Patient Class; I(npatient) or O(utpatient)
- S SRPV1(3)=$S($P(SRNODE0,"^",21)]"":$P(SRNODE0,"^",21),1:$P(SRLSS,"^",5)) ;Patient Location
- S SRPV1(7)=$P($G(^SRF(SRCASE,.1)),"^",13) ;Attending Surgeon
- S (SRPR1(11),SRPV1(17))=$P($G(^SRF(SRCASE,.1)),"^",4) ;Surgeon
- S SRPV1(18)=$O(^DIC(40.7,"C",429,0))
- S (SRPV1(44),SRPV2(8))=$P(SRNODE0,"^",9) ;Admit Date/Time
- S SRPR1(4)=$E($P(^SRF(SRCASE,"OP"),"^"),1,60) ;Principal Procedure (free text)
- S SRSURG(1)=SRCASE
- S SRSURG(2)=$P(SRLSS,"^",2)
- S SRDG1(1,4)=$E($P($G(^SRF(SRCASE,33)),"^"),1,40) ;Principal Pre-Op Diagnosis
- S SRII=$P($G(^SRF(SRCASE,8)),"^"),SRDIV=$O(^DG(40.8,"AD",SRII,0)) ;Medical Center Division/Facility
- S SRAPLR=$S(SRTP="A04":"ACCT;SROPFSS",1:"")
- ;
- ACCT ; Call IBB GETACCOUNT API to get a new Account Reference Number
- S SRCARFN=+$$GETACCT^IBBAPI(SRDFN,SRRARFN,SRTP,SRAPLR,.SRPV1,.SRPV2,.SRPR1,.SRDG1,"",SRDIV,"",.SRSURG)
- I $G(SRCARFN) S $P(^SRF(SRCASE,"PFSS"),"^")=SRCARFN
- EXIT K SRCARFN
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROPFSS 2581 printed Jan 18, 2025@03:46:13 Page 2
- SROPFSS ;BIR/SJA - Surgery/IBB GETACCOUNT API ;01/13/05 9:31 AM
- +1 ;;3.0; Surgery ;**144**;24 Jun 93
- +2 ;
- +3 ; Reference to $$GETACCT^IBBAPI is supported by DBIA #4664
- +4 ; Reference to ^DIC(40.7 is supported by DBIA #557
- +5 ; Reference to ^DG(40.8 is supported by DBIA #2817
- +6 ;
- SERR(SRCASE,SRY) ; entry point for routine SROERR & SROERR0.
- +1 IF 'SRCASE!('+$$SWSTAT^IBBAPI())!($PIECE($GET(^SRF(SRCASE,"NON")),"^")="Y")
- KILL ^TMP("SRPFSS",$JOB)
- QUIT
- +2 SET SROP=SRCASE
- SET SROPER=""
- DO ^SROP1
- +3 NEW SRCARFN,SRAPLR,SRDFN,SRDG1,SRDIV,SRGETACC,SRII,SRNODE0,SRPR1,SRPV1,SRPV2,SRRARFN,SRLSS,SRLSSC,SRSURG,SRTMP,SRTP,SRX
- +4 SET SRTP=""
- SET SRGETACC=$PIECE($GET(^SRF(SRCASE,"PFSS")),"^")
- SET SRTMP=$DATA(^TMP("SRPFSS",$JOB))
- Begin DoDot:1
- +5 IF SRY="SROERR0"
- Begin DoDot:2
- +6 IF SROPER["(REQUESTED)"
- IF SRTMP
- SET SRTP=$SELECT(SRGETACC&$DATA(SRSCHST):"A11",SRGETACC:"A08",'SRGETACC:"A04",1:"")
- QUIT
- +7 IF SROPER["(SCHEDULED)"!(SROPER["(NOT COMPLETE)")!(SROPER["(COMPLETED)")
- IF SRTMP
- SET SRTP=$SELECT('SRGETACC:"A04",1:"A08")
- QUIT
- +8 IF SROPER["(CANCELLED)"
- IF SRGETACC
- SET SRTP="A11"
- QUIT
- End DoDot:2
- +9 IF SRY="SROERR"
- Begin DoDot:2
- +10 IF SROPER["(SCHEDULED)"
- SET SRTP=$SELECT('SRGETACC:"A04",1:"A08")
- QUIT
- +11 IF SROPER["(REQUESTED)"
- SET SRTP=$SELECT(SRGETACC:"A08",'SRGETACC:"A04",1:"")
- QUIT
- +12 ;New case
- IF SROPER["NOT COMPLETE"
- IF 'SRGETACC
- IF SRTMP
- SET SRTP="A04"
- QUIT
- End DoDot:2
- End DoDot:1
- +13 ;;;I SRY["DEL"!(SROPER["CANCELLED")!(SROPER["ABORTED") S SRTP="A11" ;cancel
- ST KILL ^TMP("SRPFSS",$JOB)
- IF SRTP']""
- QUIT
- +1 SET SRNODE0=$GET(^SRF(SRCASE,0))
- +2 ;Patient ID (DFN)
- SET SRDFN=$SELECT($DATA(DFN):DFN,1:$PIECE(SRNODE0,"^"))
- +3 ;Account Reference Number
- SET SRRARFN=$SELECT((SRTP="A11"!(SRTP="A08")):SRGETACC,1:"")
- +4 SET SRLSSC=+$PIECE(SRNODE0,"^",4)
- SET SRLSS=$GET(^SRO(137.45,SRLSSC,0))
- +5 ;Patient Class; I(npatient) or O(utpatient)
- SET SRPV1(2)=$SELECT($PIECE(SRNODE0,"^",12)="I":"I",1:"O")
- +6 ;Patient Location
- SET SRPV1(3)=$SELECT($PIECE(SRNODE0,"^",21)]"":$PIECE(SRNODE0,"^",21),1:$PIECE(SRLSS,"^",5))
- +7 ;Attending Surgeon
- SET SRPV1(7)=$PIECE($GET(^SRF(SRCASE,.1)),"^",13)
- +8 ;Surgeon
- SET (SRPR1(11),SRPV1(17))=$PIECE($GET(^SRF(SRCASE,.1)),"^",4)
- +9 SET SRPV1(18)=$ORDER(^DIC(40.7,"C",429,0))
- +10 ;Admit Date/Time
- SET (SRPV1(44),SRPV2(8))=$PIECE(SRNODE0,"^",9)
- +11 ;Principal Procedure (free text)
- SET SRPR1(4)=$EXTRACT($PIECE(^SRF(SRCASE,"OP"),"^"),1,60)
- +12 SET SRSURG(1)=SRCASE
- +13 SET SRSURG(2)=$PIECE(SRLSS,"^",2)
- +14 ;Principal Pre-Op Diagnosis
- SET SRDG1(1,4)=$EXTRACT($PIECE($GET(^SRF(SRCASE,33)),"^"),1,40)
- +15 ;Medical Center Division/Facility
- SET SRII=$PIECE($GET(^SRF(SRCASE,8)),"^")
- SET SRDIV=$ORDER(^DG(40.8,"AD",SRII,0))
- +16 SET SRAPLR=$SELECT(SRTP="A04":"ACCT;SROPFSS",1:"")
- +17 ;
- ACCT ; Call IBB GETACCOUNT API to get a new Account Reference Number
- +1 SET SRCARFN=+$$GETACCT^IBBAPI(SRDFN,SRRARFN,SRTP,SRAPLR,.SRPV1,.SRPV2,.SRPR1,.SRDG1,"",SRDIV,"",.SRSURG)
- +2 IF $GET(SRCARFN)
- SET $PIECE(^SRF(SRCASE,"PFSS"),"^")=SRCARFN
- EXIT KILL SRCARFN
- +1 QUIT