- SRONP2 ;BIR/ADM - PROCEDURE REPORT (NON-OR) ;07/26/04 9:45 AM
- ;;3.0; Surgery ;**132,142**;24 Jun 93
- Q
- OPTOP(SRTN) ; send op-top to ^TMP
- ; SRTN - case number in file 130
- ;
- N ANE,DFN,ICD,J,NUM,SR,SRATT,SRCASE,SRDIV,SRI,SRL,SRLINE,SRLOC,SRN,SROPTOP,SRSPEC,SRSTATUS,SRTECH,X,Y
- S SRCASE=SRTN,SRG=$NA(^TMP("SRNOR",$J,SRCASE)) K @SRG
- S SRI=0,SRDIV=$$SITE^SROUTL0(SRTN)
- I $P($G(^SRF(SRTN,30)),"^")!$P($G(^SRF(SRTN,31)),"^",8) D LINE(1) S @SRG@(SRI)=" * * PROCEDURE ABORTED * *" D LINE(1)
- F SRN=0:.1:1.1,"NON" S SR(SRN)=$G(^SRF(SRTN,SRN))
- S Y=$P(SR("NON"),"^",8),C=$P(^DD(130,125,0),"^",2) D:Y'="" Y^DIQ S SRSPEC=$S(Y="":"NOT ENTERED",1:$E(Y,1,25))
- S SRLOC="NOT ENTERED",SRL=$P(SR("NON"),"^",2) S:SRL SRLOC=$E($P(^SC(SRL,0),"^"),1,25)
- D LINE(1) S @SRG@(SRI)="Med. Specialty: "_SRSPEC,@SRG@(SRI)=@SRG@(SRI)_$$SPACE(44)_"Location: "_SRLOC
- S X=$P($G(^SRF(SRTN,33)),"^",2) D LINE(2) S @SRG@(SRI)="Principal Diagnosis: " D
- .I X="" S @SRG@(SRI)=@SRG@(SRI)_"NOT ENTERED" Q
- .D LINE(1) S @SRG@(SRI)=" "_X
- .S @SRG@(SRI)=@SRG@(SRI)
- .N OTH,CNT S (OTH,CNT)=0 F S OTH=$O(^SRF(SRTN,15,OTH)) Q:'OTH S CNT=CNT+1 D DIAG
- S Y=$P(SR("NON"),"^",6),C=$P(^DD(130,123,0),"^",2) D:Y'="" Y^DIQ D LINE(2) S @SRG@(SRI)="Provider: "_Y
- S X=$P($G(SR(0)),"^",12),SRSTATUS=$S(X="I":"INPATIENT",X="O":"OUTPATIENT",1:"NOT ENTERED")
- S @SRG@(SRI)=@SRG@(SRI)_$$SPACE(50)_"Patient Status: "_SRSTATUS
- S Y=$P(SR("NON"),"^",7),C=$P(^DD(130,124,0),"^",2) D:Y'="" Y^DIQ,N(28) S:Y="" Y="N/A" D LINE(1) S @SRG@(SRI)="Attending: "_Y
- D RS S:SRATT="" SRATT="NOT ENTERED" D LINE(1) S @SRG@(SRI)="Attending Code: "_SRATT
- S Y=$P(SR(.3),"^",4),C=$P(^DD(130,.34,0),"^",2) D:Y'="" Y^DIQ S:Y="" Y="N/A" D LINE(2) S @SRG@(SRI)="Attend Anesth: "_Y
- S X=$P(SR(.3),"^",6),X=$S(X:$P(^SRO(132.95,X,0),"^"),1:"N/A")
- D LINE(1) S @SRG@(SRI)="Anesthesia Supervisor Code: "_X
- S Y=$P(SR(.3),"^"),C=$P(^DD(130,.31,0),"^",2) D:Y'="" Y^DIQ S:Y="" Y="N/A" D LINE(1) S @SRG@(SRI)="Anesthetist: "_Y
- D LINE(2) S @SRG@(SRI)="Anesthesia Technique(s): " D
- .I '$O(^SRF(SRTN,6,0)) S @SRG@(SRI)=@SRG@(SRI)_"N/A" Q
- .S ANE=0 F S ANE=$O(^SRF(SRTN,6,ANE)) Q:'ANE D ANE
- D TECH I $E(SRTECH,1,2)'="NO" S X=$P($G(^SRF(SRTN,31)),"^",9),X=$S(X="N":"NO",X="Y":"YES",1:"") I X'="" D LINE(2) S @SRG@(SRI)="Diagnostic/Therapeutic: "_X
- D ^SRONP0
- Q
- DIAG D LINE(1) S X=$G(^SRF(SRTN,15,OTH,0)),@SRG@(SRI)=$S(CNT=1:" Other: ",1:" ")_$P(X,"^"),ICD=$P(X,"^",3)
- S ICD=$S(ICD:$P(^ICD9(ICD,0),"^"),1:"NOT ENTERED"),@SRG@(SRI)=@SRG@(SRI)_$$SPACE(50)_"ICD9 Code: "_ICD
- Q
- N(SRL) N SRNM I $L(Y)>SRL S SRNM=$P(Y,",")_","_$E($P(Y,",",2))_".",Y=SRNM
- Q
- TECH N SRT,SRZ D TECH^SROPRIN
- Q
- ANE ; print anesthesia technique
- N A,AGNT,C,CNT
- S A=^SRF(SRTN,6,ANE,0),Y=$P(A,"^"),C=$P(^DD(130.06,.01,0),"^",2) D:Y'="" Y^DIQ D LINE(1) S Y=Y_$S($P(A,"^",3)="Y":" (PRINCIPAL)",1:""),@SRG@(SRI)=$$SPACE(2)_Y D AGENT
- Q
- AGENT ; print agents
- Q:$P(A,"^")="N" N SRDOSE,SRY
- D LINE(1) S @SRG@(SRI)=" Agent: " I '$O(^SRF(SRTN,6,ANE,1,0)) S @SRG@(SRI)=@SRG@(SRI)_"NONE ENTERED" Q
- S (AGNT,CNT)=0 F S AGNT=$O(^SRF(SRTN,6,ANE,1,AGNT)) Q:'AGNT S CNT=CNT+1 D
- .S SRY=^SRF(SRTN,6,ANE,1,AGNT,0),SRDOSE=$P(SRY,"^",2)
- .S Y=$P(SRY,"^"),C=$P(^DD(130.47,.01,0),"^",2) D Y^DIQ
- .D:CNT>1 LINE(1) S @SRG@(SRI)=@SRG@(SRI)_$$SPACE(13)_Y
- .I SRDOSE S @SRG@(SRI)=@SRG@(SRI)_" "_SRDOSE_" mg"
- Q
- RS ; attending code
- I $$GET1^DID(130,.166,"","LABEL")["ATTENDING CODE" D Q
- .S Y=$P(SR(.1),"^",10),C=$P(^DD(130,.166,0),"^",2) D Y^DIQ S SRATT=Y
- S Y=$P(SR(.1),"^",16),C=$P(^DD(130,.165,0),"^",2) D Y^DIQ S SRATT=Y
- Q
- COMM(X,NUM) ; output word-processing text
- ; X = line of text to be processed
- ; NUM = left margin
- N I,J,K,Y,SRL S SRL=80-NUM
- I $L(X)<(SRL+1)!($E(X,1,SRL)'[" ") D LINE(1) S @SRG@(SRI)=$$SPACE(NUM)_X Q
- S K=1 F D I $L(X)<SRL+1 S X(K)=X Q
- .F I=0:1:SRL-1 S J=SRL-I,Y=$E(X,J) I Y=" " S X(K)=$E(X,1,J-1),X=$E(X,J+1,$L(X)) S K=K+1 Q
- F I=1:1:K D LINE(1) S @SRG@(SRI)=$$SPACE(NUM)_X(I)
- Q
- SPACE(NUM) ; create spaces
- ; pass in position returns number of needed spaces
- I '$D(@SRG@(SRI)) S @SRG@(SRI)=""
- Q $J("",NUM-$L(@SRG@(SRI)))
- LINE(NUM) ; create carriage returns
- F J=1:1:NUM S SRI=SRI+1,@SRG@(SRI)=""
- Q
- SRONP2 ;BIR/ADM - PROCEDURE REPORT (NON-OR) ;07/26/04 9:45 AM
- +1 ;;3.0; Surgery ;**132,142**;24 Jun 93
- +2 QUIT
- OPTOP(SRTN) ; send op-top to ^TMP
- +1 ; SRTN - case number in file 130
- +2 ;
- +3 NEW ANE,DFN,ICD,J,NUM,SR,SRATT,SRCASE,SRDIV,SRI,SRL,SRLINE,SRLOC,SRN,SROPTOP,SRSPEC,SRSTATUS,SRTECH,X,Y
- +4 SET SRCASE=SRTN
- SET SRG=$NAME(^TMP("SRNOR",$JOB,SRCASE))
- KILL @SRG
- +5 SET SRI=0
- SET SRDIV=$$SITE^SROUTL0(SRTN)
- +6 IF $PIECE($GET(^SRF(SRTN,30)),"^")!$PIECE($GET(^SRF(SRTN,31)),"^",8)
- DO LINE(1)
- SET @SRG@(SRI)=" * * PROCEDURE ABORTED * *"
- DO LINE(1)
- +7 FOR SRN=0:.1:1.1,"NON"
- SET SR(SRN)=$GET(^SRF(SRTN,SRN))
- +8 SET Y=$PIECE(SR("NON"),"^",8)
- SET C=$PIECE(^DD(130,125,0),"^",2)
- IF Y'=""
- DO Y^DIQ
- SET SRSPEC=$SELECT(Y="":"NOT ENTERED",1:$EXTRACT(Y,1,25))
- +9 SET SRLOC="NOT ENTERED"
- SET SRL=$PIECE(SR("NON"),"^",2)
- IF SRL
- SET SRLOC=$EXTRACT($PIECE(^SC(SRL,0),"^"),1,25)
- +10 DO LINE(1)
- SET @SRG@(SRI)="Med. Specialty: "_SRSPEC
- SET @SRG@(SRI)=@SRG@(SRI)_$$SPACE(44)_"Location: "_SRLOC
- +11 SET X=$PIECE($GET(^SRF(SRTN,33)),"^",2)
- DO LINE(2)
- SET @SRG@(SRI)="Principal Diagnosis: "
- Begin DoDot:1
- +12 IF X=""
- SET @SRG@(SRI)=@SRG@(SRI)_"NOT ENTERED"
- QUIT
- +13 DO LINE(1)
- SET @SRG@(SRI)=" "_X
- +14 SET @SRG@(SRI)=@SRG@(SRI)
- +15 NEW OTH,CNT
- SET (OTH,CNT)=0
- FOR
- SET OTH=$ORDER(^SRF(SRTN,15,OTH))
- IF 'OTH
- QUIT
- SET CNT=CNT+1
- DO DIAG
- End DoDot:1
- +16 SET Y=$PIECE(SR("NON"),"^",6)
- SET C=$PIECE(^DD(130,123,0),"^",2)
- IF Y'=""
- DO Y^DIQ
- DO LINE(2)
- SET @SRG@(SRI)="Provider: "_Y
- +17 SET X=$PIECE($GET(SR(0)),"^",12)
- SET SRSTATUS=$SELECT(X="I":"INPATIENT",X="O":"OUTPATIENT",1:"NOT ENTERED")
- +18 SET @SRG@(SRI)=@SRG@(SRI)_$$SPACE(50)_"Patient Status: "_SRSTATUS
- +19 SET Y=$PIECE(SR("NON"),"^",7)
- SET C=$PIECE(^DD(130,124,0),"^",2)
- IF Y'=""
- DO Y^DIQ
- DO N(28)
- IF Y=""
- SET Y="N/A"
- DO LINE(1)
- SET @SRG@(SRI)="Attending: "_Y
- +20 DO RS
- IF SRATT=""
- SET SRATT="NOT ENTERED"
- DO LINE(1)
- SET @SRG@(SRI)="Attending Code: "_SRATT
- +21 SET Y=$PIECE(SR(.3),"^",4)
- SET C=$PIECE(^DD(130,.34,0),"^",2)
- IF Y'=""
- DO Y^DIQ
- IF Y=""
- SET Y="N/A"
- DO LINE(2)
- SET @SRG@(SRI)="Attend Anesth: "_Y
- +22 SET X=$PIECE(SR(.3),"^",6)
- SET X=$SELECT(X:$PIECE(^SRO(132.95,X,0),"^"),1:"N/A")
- +23 DO LINE(1)
- SET @SRG@(SRI)="Anesthesia Supervisor Code: "_X
- +24 SET Y=$PIECE(SR(.3),"^")
- SET C=$PIECE(^DD(130,.31,0),"^",2)
- IF Y'=""
- DO Y^DIQ
- IF Y=""
- SET Y="N/A"
- DO LINE(1)
- SET @SRG@(SRI)="Anesthetist: "_Y
- +25 DO LINE(2)
- SET @SRG@(SRI)="Anesthesia Technique(s): "
- Begin DoDot:1
- +26 IF '$ORDER(^SRF(SRTN,6,0))
- SET @SRG@(SRI)=@SRG@(SRI)_"N/A"
- QUIT
- +27 SET ANE=0
- FOR
- SET ANE=$ORDER(^SRF(SRTN,6,ANE))
- IF 'ANE
- QUIT
- DO ANE
- End DoDot:1
- +28 DO TECH
- IF $EXTRACT(SRTECH,1,2)'="NO"
- SET X=$PIECE($GET(^SRF(SRTN,31)),"^",9)
- SET X=$SELECT(X="N":"NO",X="Y":"YES",1:"")
- IF X'=""
- DO LINE(2)
- SET @SRG@(SRI)="Diagnostic/Therapeutic: "_X
- +29 DO ^SRONP0
- +30 QUIT
- DIAG DO LINE(1)
- SET X=$GET(^SRF(SRTN,15,OTH,0))
- SET @SRG@(SRI)=$SELECT(CNT=1:" Other: ",1:" ")_$PIECE(X,"^")
- SET ICD=$PIECE(X,"^",3)
- +1 SET ICD=$SELECT(ICD:$PIECE(^ICD9(ICD,0),"^"),1:"NOT ENTERED")
- SET @SRG@(SRI)=@SRG@(SRI)_$$SPACE(50)_"ICD9 Code: "_ICD
- +2 QUIT
- N(SRL) NEW SRNM
- IF $LENGTH(Y)>SRL
- SET SRNM=$PIECE(Y,",")_","_$EXTRACT($PIECE(Y,",",2))_"."
- SET Y=SRNM
- +1 QUIT
- TECH NEW SRT,SRZ
- DO TECH^SROPRIN
- +1 QUIT
- ANE ; print anesthesia technique
- +1 NEW A,AGNT,C,CNT
- +2 SET A=^SRF(SRTN,6,ANE,0)
- SET Y=$PIECE(A,"^")
- SET C=$PIECE(^DD(130.06,.01,0),"^",2)
- IF Y'=""
- DO Y^DIQ
- DO LINE(1)
- SET Y=Y_$SELECT($PIECE(A,"^",3)="Y":" (PRINCIPAL)",1:"")
- SET @SRG@(SRI)=$$SPACE(2)_Y
- DO AGENT
- +3 QUIT
- AGENT ; print agents
- +1 IF $PIECE(A,"^")="N"
- QUIT
- NEW SRDOSE,SRY
- +2 DO LINE(1)
- SET @SRG@(SRI)=" Agent: "
- IF '$ORDER(^SRF(SRTN,6,ANE,1,0))
- SET @SRG@(SRI)=@SRG@(SRI)_"NONE ENTERED"
- QUIT
- +3 SET (AGNT,CNT)=0
- FOR
- SET AGNT=$ORDER(^SRF(SRTN,6,ANE,1,AGNT))
- IF 'AGNT
- QUIT
- SET CNT=CNT+1
- Begin DoDot:1
- +4 SET SRY=^SRF(SRTN,6,ANE,1,AGNT,0)
- SET SRDOSE=$PIECE(SRY,"^",2)
- +5 SET Y=$PIECE(SRY,"^")
- SET C=$PIECE(^DD(130.47,.01,0),"^",2)
- DO Y^DIQ
- +6 IF CNT>1
- DO LINE(1)
- SET @SRG@(SRI)=@SRG@(SRI)_$$SPACE(13)_Y
- +7 IF SRDOSE
- SET @SRG@(SRI)=@SRG@(SRI)_" "_SRDOSE_" mg"
- End DoDot:1
- +8 QUIT
- RS ; attending code
- +1 IF $$GET1^DID(130,.166,"","LABEL")["ATTENDING CODE"
- Begin DoDot:1
- +2 SET Y=$PIECE(SR(.1),"^",10)
- SET C=$PIECE(^DD(130,.166,0),"^",2)
- DO Y^DIQ
- SET SRATT=Y
- End DoDot:1
- QUIT
- +3 SET Y=$PIECE(SR(.1),"^",16)
- SET C=$PIECE(^DD(130,.165,0),"^",2)
- DO Y^DIQ
- SET SRATT=Y
- +4 QUIT
- COMM(X,NUM) ; output word-processing text
- +1 ; X = line of text to be processed
- +2 ; NUM = left margin
- +3 NEW I,J,K,Y,SRL
- SET SRL=80-NUM
- +4 IF $LENGTH(X)<(SRL+1)!($EXTRACT(X,1,SRL)'[" ")
- DO LINE(1)
- SET @SRG@(SRI)=$$SPACE(NUM)_X
- QUIT
- +5 SET K=1
- FOR
- Begin DoDot:1
- +6 FOR I=0:1:SRL-1
- SET J=SRL-I
- SET Y=$EXTRACT(X,J)
- IF Y=" "
- SET X(K)=$EXTRACT(X,1,J-1)
- SET X=$EXTRACT(X,J+1,$LENGTH(X))
- SET K=K+1
- QUIT
- End DoDot:1
- IF $LENGTH(X)<SRL+1
- SET X(K)=X
- QUIT
- +7 FOR I=1:1:K
- DO LINE(1)
- SET @SRG@(SRI)=$$SPACE(NUM)_X(I)
- +8 QUIT
- SPACE(NUM) ; create spaces
- +1 ; pass in position returns number of needed spaces
- +2 IF '$DATA(@SRG@(SRI))
- SET @SRG@(SRI)=""
- +3 QUIT $JUSTIFY("",NUM-$LENGTH(@SRG@(SRI)))
- LINE(NUM) ; create carriage returns
- +1 FOR J=1:1:NUM
- SET SRI=SRI+1
- SET @SRG@(SRI)=""
- +2 QUIT
