- SRSCOR ;B'HAM ISC/SJA - Surgery/CoreFLS API ; [ 12/6/01 8:59 AM ]
- ;;3.0; Surgery ;**107,127**;24 Jun 93
- ;
- ; Reference to $$MOD^ICPTMOD supported by DBIA #1996
- ; Reference to $$BLDSEG^CSLSUR1 is supported by DBIA #3498
- ; Reference to ^DIC(45.3 is supported by DBIA #218
- ; Reference to ^TMP("CSLSUR1" is supported by DBIA #3498
- ;
- ST(SRTN) S X="CSLSUR1" X ^%ZOSF("TEST") G:'$T EXIT
- N DYNOTE,II,JJ,MM,L,LSS,LSSC,LSSN,NSSIEN,OCIEN,OCPT,OMIEN,OR,ORN,PM,PMIEN,SPF,SRNODE0,SRNODE30,SRNODE31,SROP,SURGN,ASURG,SRICN,SRICPT,SRSP,SROP,SROPER
- K ^TMP("CSLSUR1",$J)
- S SRNODE0=$G(^SRF(SRTN,0)),SRNODE30=$G(^SRF(SRTN,30)),SRNODE31=$G(^SRF(SRTN,31))
- AR1 ; Schedule ID
- S ^TMP("CSLSUR1",$J,1)=SRTN
- AR2 ; Patient ID (DFN) and ICN
- S X="MPIF001",SRICN="" X ^%ZOSF("TEST") I $T S SRICN=$$GETICN^MPIF001($P(SRNODE0,"^"))
- S ^TMP("CSLSUR1",$J,2)=$P(SRNODE0,"^")_"^"_$S($P(SRICN,"^")=-1:"",1:SRICN)
- AR3 ; Type of Action
- S ^TMP("CSLSUR1",$J,3)=SRTYPE
- ;$S(SRTYPE=1:"NEW",SRTYPE=2:"EDIT",SRTYPE=3:"CANCEL",SRTYPE=4:"DELETE",1:"")
- AR4 ; Date/Time of Surgery
- S ^TMP("CSLSUR1",$J,4)=$P(SRNODE31,"^",4)_"^"_$P(SRNODE31,"^",5)_"^"_$P(SRNODE0,"^",9)
- ;
- AR5 ; Principle CPT code & Name
- S SROP=$G(^SRF(SRTN,"OP")),^TMP("CSLSUR1",$J,5,0)=$P(SROP,"^")
- I +$P(SROP,"^",2) S SRICPT=$$CPT^ICPTCOD($P(SROP,"^",2),$P($G(^SRF(SRTN,0)),"^",9)),^TMP("CSLSUR1",$J,5,1)=$P(SRICPT,"^",2)_"^"_$P(SRICPT,"^",3)
- ;
- ; CPT modifiers for principle code (X = sequential number)
- S PM=0 F S PM=$O(^SRF(SRTN,"OPMOD",PM)) Q:'PM S PMIEN=$P($G(^(PM,0)),"^") D
- .S ^TMP("CSLSUR1",$J,5,1,PM)=$P($$MOD^ICPTMOD(PMIEN,"I",$P($G(^SRF(SRTN,0)),"^",9)),"^",2,3)
- ;
- ; Other CPT codes and names (N = value greater than 1)
- S II=0,JJ=1 F S II=$O(^SRF(SRTN,13,II)) Q:'II S OCIEN=$G(^(II,2)) D
- .I +OCIEN S OCPT=$$CPT^ICPTCOD(+OCIEN,$P($G(^SRF(SRTN,0)),"^",9)) S JJ=JJ+1,^TMP("CSLSUR1",$J,5,JJ)=$P(OCPT,"^",2)_"^"_$P(OCPT,"^",3)
- .;
- .;CPT code modifiers
- .S MM=0 F S MM=$O(^SRF(SRTN,13,II,"MOD",MM)) Q:'MM S OMIEN=$G(^SRF(SRTN,13,II,"MOD",MM,0)),^TMP("CSLSUR1",$J,5,JJ,MM)=$P($$MOD^ICPTMOD(OMIEN,"I",$P($G(^SRF(SRTN,0)),"^",9)),"^",2,3)
- AR6 ; Surgeon ID & Name
- S SURGN=$P($G(^SRF(SRTN,.1)),"^",4)
- I +SURGN S ^TMP("CSLSUR1",$J,6)=SURGN_"^"_$P($G(^VA(200,+SURGN,0)),"^")
- AR7 ; Surgical Specialty Code & Name
- S LSSC=+$P(SRNODE0,"^",4),LSS=$G(^SRO(137.45,LSSC,0)),LSSN=$P(LSS,"^")
- S NSSIEN=$P(LSS,"^",2)
- I +NSSIEN S ^TMP("CSLSUR1",$J,7)=$P($G(^DIC(45.3,+NSSIEN,0)),"^",1,2)
- AR8 ; Local Surgical Specialty Code & Name
- I +LSSC!(LSSN'="") S ^TMP("CSLSUR1",$J,8)=$P(LSS,"^",4)_"^"_LSSN
- AR9 ; Operating Room
- S OR=$P(SRNODE0,"^",2),JJ=$P($G(^SRS(+OR,0)),"^"),ORN=$G(^SC(+JJ,0))
- I +JJ S ^TMP("CSLSUR1",$J,9)=JJ_"^"_$P(ORN,"^")
- AR10 ; SPD Comments
- S L=0 F S L=$O(^SRF(SRTN,80,L)) Q:'L S X=$G(^SRF(SRTN,80,L,0)) D
- .S ^TMP("CSLSUR1",$J,10,L)=X
- AR11 ; Hospital
- S SPF=$P($G(^SRO(133,+$$SITE^SROUTL0(SRTN),0)),"^")
- I +SPF S ^TMP("CSLSUR1",$J,11)=SPF_"^"_$$GET1^DIQ(4,+SPF,.01)
- AR12 ; Scheduled by
- S SRSP=$P($G(^SRF(SRTN,"1.0")),"^",10)
- I +SRSP S ^TMP("CSLSUR1",$J,12)=SRSP_"^"_$P($G(^VA(200,+SRSP,0)),"^")
- AR13 ; Entered by
- S ^TMP("CSLSUR1",$J,13)=DUZ_"^"_$P($G(^VA(200,+DUZ,0)),"^")
- AR14 ; IN/OUT-PATIENT STATUS
- I $P(SRNODE0,"^",12)'="" S ^TMP("CSLSUR1",$J,14)=$P(SRNODE0,"^",12)
- AR15 ; Time Stamp
- D NOW^%DTC S ^TMP("CSLSUR1",$J,15)=%
- AR16 ; Attending Surgeon
- S ASURG=$P($G(^SRF(SRTN,.1)),"^",13)
- I +ASURG S ^TMP("CSLSUR1",$J,16)=ASURG_"^"_$P($G(^VA(200,+ASURG,0)),"^")
- ;
- SEND ; Call CoreFLS API
- S DYNOTE=+$$BLDSEG^CSLSUR1(1)
- I '$P(SRNODE31,"^",10) S $P(^SRF(SRTN,31),"^",10)=$S(DYNOTE=1:1,1:0)
- S SROP=SRTN,SROPER="" D ^SROP1 I SROPER["REQUESTED" S $P(^SRF(SRTN,31),"^",10)=0
- EXIT K ^TMP("CSLSUR1",$J)
- Q
- CHKS(SRDA) ; Calculate checksum of SPD COMMENTS field
- N J,L,X,SRCSUM S SRCSUM=0
- S L=0 F S L=$O(^SRF(SRDA,80,L)) Q:'L S X=^SRF(SRDA,80,L,0) F J=1:1:$L(X) S SRCSUM=L*J*$A(X,J)+SRCSUM
- Q SRCSUM
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSRSCOR 3940 printed Jan 18, 2025@03:48:32 Page 2
- SRSCOR ;B'HAM ISC/SJA - Surgery/CoreFLS API ; [ 12/6/01 8:59 AM ]
- +1 ;;3.0; Surgery ;**107,127**;24 Jun 93
- +2 ;
- +3 ; Reference to $$MOD^ICPTMOD supported by DBIA #1996
- +4 ; Reference to $$BLDSEG^CSLSUR1 is supported by DBIA #3498
- +5 ; Reference to ^DIC(45.3 is supported by DBIA #218
- +6 ; Reference to ^TMP("CSLSUR1" is supported by DBIA #3498
- +7 ;
- ST(SRTN) SET X="CSLSUR1"
- XECUTE ^%ZOSF("TEST")
- if '$TEST
- GOTO EXIT
- +1 NEW DYNOTE,II,JJ,MM,L,LSS,LSSC,LSSN,NSSIEN,OCIEN,OCPT,OMIEN,OR,ORN,PM,PMIEN,SPF,SRNODE0,SRNODE30,SRNODE31,SROP,SURGN,ASURG,SRICN,SRICPT,SRSP,SROP,SROPER
- +2 KILL ^TMP("CSLSUR1",$JOB)
- +3 SET SRNODE0=$GET(^SRF(SRTN,0))
- SET SRNODE30=$GET(^SRF(SRTN,30))
- SET SRNODE31=$GET(^SRF(SRTN,31))
- AR1 ; Schedule ID
- +1 SET ^TMP("CSLSUR1",$JOB,1)=SRTN
- AR2 ; Patient ID (DFN) and ICN
- +1 SET X="MPIF001"
- SET SRICN=""
- XECUTE ^%ZOSF("TEST")
- IF $TEST
- SET SRICN=$$GETICN^MPIF001($PIECE(SRNODE0,"^"))
- +2 SET ^TMP("CSLSUR1",$JOB,2)=$PIECE(SRNODE0,"^")_"^"_$SELECT($PIECE(SRICN,"^")=-1:"",1:SRICN)
- AR3 ; Type of Action
- +1 SET ^TMP("CSLSUR1",$JOB,3)=SRTYPE
- +2 ;$S(SRTYPE=1:"NEW",SRTYPE=2:"EDIT",SRTYPE=3:"CANCEL",SRTYPE=4:"DELETE",1:"")
- AR4 ; Date/Time of Surgery
- +1 SET ^TMP("CSLSUR1",$JOB,4)=$PIECE(SRNODE31,"^",4)_"^"_$PIECE(SRNODE31,"^",5)_"^"_$PIECE(SRNODE0,"^",9)
- +2 ;
- AR5 ; Principle CPT code & Name
- +1 SET SROP=$GET(^SRF(SRTN,"OP"))
- SET ^TMP("CSLSUR1",$JOB,5,0)=$PIECE(SROP,"^")
- +2 IF +$PIECE(SROP,"^",2)
- SET SRICPT=$$CPT^ICPTCOD($PIECE(SROP,"^",2),$PIECE($GET(^SRF(SRTN,0)),"^",9))
- SET ^TMP("CSLSUR1",$JOB,5,1)=$PIECE(SRICPT,"^",2)_"^"_$PIECE(SRICPT,"^",3)
- +3 ;
- +4 ; CPT modifiers for principle code (X = sequential number)
- +5 SET PM=0
- FOR
- SET PM=$ORDER(^SRF(SRTN,"OPMOD",PM))
- if 'PM
- QUIT
- SET PMIEN=$PIECE($GET(^(PM,0)),"^")
- Begin DoDot:1
- +6 SET ^TMP("CSLSUR1",$JOB,5,1,PM)=$PIECE($$MOD^ICPTMOD(PMIEN,"I",$PIECE($GET(^SRF(SRTN,0)),"^",9)),"^",2,3)
- End DoDot:1
- +7 ;
- +8 ; Other CPT codes and names (N = value greater than 1)
- +9 SET II=0
- SET JJ=1
- FOR
- SET II=$ORDER(^SRF(SRTN,13,II))
- if 'II
- QUIT
- SET OCIEN=$GET(^(II,2))
- Begin DoDot:1
- +10 IF +OCIEN
- SET OCPT=$$CPT^ICPTCOD(+OCIEN,$PIECE($GET(^SRF(SRTN,0)),"^",9))
- SET JJ=JJ+1
- SET ^TMP("CSLSUR1",$JOB,5,JJ)=$PIECE(OCPT,"^",2)_"^"_$PIECE(OCPT,"^",3)
- +11 ;
- +12 ;CPT code modifiers
- +13 SET MM=0
- FOR
- SET MM=$ORDER(^SRF(SRTN,13,II,"MOD",MM))
- if 'MM
- QUIT
- SET OMIEN=$GET(^SRF(SRTN,13,II,"MOD",MM,0))
- SET ^TMP("CSLSUR1",$JOB,5,JJ,MM)=$PIECE($$MOD^ICPTMOD(OMIEN,"I",$PIECE($GET(^SRF(SRTN,0)),"^",9)),"^",2,3)
- End DoDot:1
- AR6 ; Surgeon ID & Name
- +1 SET SURGN=$PIECE($GET(^SRF(SRTN,.1)),"^",4)
- +2 IF +SURGN
- SET ^TMP("CSLSUR1",$JOB,6)=SURGN_"^"_$PIECE($GET(^VA(200,+SURGN,0)),"^")
- AR7 ; Surgical Specialty Code & Name
- +1 SET LSSC=+$PIECE(SRNODE0,"^",4)
- SET LSS=$GET(^SRO(137.45,LSSC,0))
- SET LSSN=$PIECE(LSS,"^")
- +2 SET NSSIEN=$PIECE(LSS,"^",2)
- +3 IF +NSSIEN
- SET ^TMP("CSLSUR1",$JOB,7)=$PIECE($GET(^DIC(45.3,+NSSIEN,0)),"^",1,2)
- AR8 ; Local Surgical Specialty Code & Name
- +1 IF +LSSC!(LSSN'="")
- SET ^TMP("CSLSUR1",$JOB,8)=$PIECE(LSS,"^",4)_"^"_LSSN
- AR9 ; Operating Room
- +1 SET OR=$PIECE(SRNODE0,"^",2)
- SET JJ=$PIECE($GET(^SRS(+OR,0)),"^")
- SET ORN=$GET(^SC(+JJ,0))
- +2 IF +JJ
- SET ^TMP("CSLSUR1",$JOB,9)=JJ_"^"_$PIECE(ORN,"^")
- AR10 ; SPD Comments
- +1 SET L=0
- FOR
- SET L=$ORDER(^SRF(SRTN,80,L))
- if 'L
- QUIT
- SET X=$GET(^SRF(SRTN,80,L,0))
- Begin DoDot:1
- +2 SET ^TMP("CSLSUR1",$JOB,10,L)=X
- End DoDot:1
- AR11 ; Hospital
- +1 SET SPF=$PIECE($GET(^SRO(133,+$$SITE^SROUTL0(SRTN),0)),"^")
- +2 IF +SPF
- SET ^TMP("CSLSUR1",$JOB,11)=SPF_"^"_$$GET1^DIQ(4,+SPF,.01)
- AR12 ; Scheduled by
- +1 SET SRSP=$PIECE($GET(^SRF(SRTN,"1.0")),"^",10)
- +2 IF +SRSP
- SET ^TMP("CSLSUR1",$JOB,12)=SRSP_"^"_$PIECE($GET(^VA(200,+SRSP,0)),"^")
- AR13 ; Entered by
- +1 SET ^TMP("CSLSUR1",$JOB,13)=DUZ_"^"_$PIECE($GET(^VA(200,+DUZ,0)),"^")
- AR14 ; IN/OUT-PATIENT STATUS
- +1 IF $PIECE(SRNODE0,"^",12)'=""
- SET ^TMP("CSLSUR1",$JOB,14)=$PIECE(SRNODE0,"^",12)
- AR15 ; Time Stamp
- +1 DO NOW^%DTC
- SET ^TMP("CSLSUR1",$JOB,15)=%
- AR16 ; Attending Surgeon
- +1 SET ASURG=$PIECE($GET(^SRF(SRTN,.1)),"^",13)
- +2 IF +ASURG
- SET ^TMP("CSLSUR1",$JOB,16)=ASURG_"^"_$PIECE($GET(^VA(200,+ASURG,0)),"^")
- +3 ;
- SEND ; Call CoreFLS API
- +1 SET DYNOTE=+$$BLDSEG^CSLSUR1(1)
- +2 IF '$PIECE(SRNODE31,"^",10)
- SET $PIECE(^SRF(SRTN,31),"^",10)=$SELECT(DYNOTE=1:1,1:0)
- +3 SET SROP=SRTN
- SET SROPER=""
- DO ^SROP1
- IF SROPER["REQUESTED"
- SET $PIECE(^SRF(SRTN,31),"^",10)=0
- EXIT KILL ^TMP("CSLSUR1",$JOB)
- +1 QUIT
- CHKS(SRDA) ; Calculate checksum of SPD COMMENTS field
- +1 NEW J,L,X,SRCSUM
- SET SRCSUM=0
- +2 SET L=0
- FOR
- SET L=$ORDER(^SRF(SRDA,80,L))
- if 'L
- QUIT
- SET X=^SRF(SRDA,80,L,0)
- FOR J=1:1:$LENGTH(X)
- SET SRCSUM=L*J*$ASCII(X,J)+SRCSUM
- +3 QUIT SRCSUM