SROCMPS ;BIR/MAM - ENTER/EDIT OCCURRENCES ;06/17/04 6:55 AM
;;3.0;Surgery;**14,32,38,95,102,116,125,142,177**;24 Jun 93;Build 89
INTRA S SRTYPE=10,SRTY="INTRAOPERATIVE",SRTYPDD="130.13A"
POST I '$D(SRTYPE) S SRTYPE=16,SRTY="POSTOPERATIVE",SRTYPDD="130.22A"
W @IOF,! S SRSOUT=0 I '$D(SRTN) S SRTN1=1 D ^SROPS I '$D(SRTN) S SRSOUT=1 G END
D SRA^SROES
S SRSUPCPT=1 D ^SROAUTL S SRNAME=$P(VADM(1),"^")_" ("_VA("PID")_")",SRLINE="" F I=0:1:79 S SRLINE=SRLINE_"-"
EDIT G:SRSOUT END K SRCOMP S SRNEW=0
I '$O(^SRF(SRTN,SRTYPE,0)) D NEW G:SRSOUT END D ^SROCMPED G EDIT
D HDR^SROAUTL W "Enter/Edit "_$S(SRTYPE=10:"Intraoperative",1:"Postoperative")_" Occurrences",! S (COMP,CNT)=0 F S COMP=$O(^SRF(SRTN,SRTYPE,COMP)) Q:'COMP D LIST
SEL W !,"Select a number ("_$S(CNT=1:1,1:"1-"_CNT)_"), or type 'NEW' to enter another occurrence: " R X:DTIME I '$T!("^"[X) S SRSOUT=1 G END
K SRENTRY I $E(X)="N"!($E(X)="n") D NEW G:SRSOUT END D ^SROCMPED G EDIT
I '$D(SRCOMP(X)) W !!,"Select the number corresponding to the occurrence you want to update, or",!,"enter 'NEW' to add another occurrence. ",!!,"Press RETURN to continue " R X:DTIME G EDIT
S:'$D(SRENTRY) SRENTRY=$P(SRCOMP(X),"^",3) D ^SROCMPED G EDIT
Q
END D:$D(SRTN) EN^SROCCAT,EXIT^SROES I $D(SRTN1) K SRTN,SRTN1
I 'SRSOUT W !!,"Press RETURN to continue " R X:DTIME
D:'$D(SROVER) ^SRSKILL W @IOF
Q
LIST ; list existing occurrences
S CNT=CNT+1,SRC(0)=^SRF(SRTN,SRTYPE,COMP,0),SRCMP=$P(SRC(0),"^"),SRCAT=$P(SRC(0),"^",2),SRCAT=$S(SRCAT:$P(^SRO(136.5,SRCAT,0),"^"),1:"NOT ENTERED"),SRCOMP(CNT)=SRCMP_"^"_SRCAT_"^"_COMP
W !,CNT_". ",?5,SRCMP,!,?5,"Category: "_SRCAT,!
Q
NEW ; enter new occurrences
D HDR^SROAUTL W ! I '$O(^SRF(SRTN,SRTYPE,0)) W !,"There are no "_$S(SRTYPE=10:"Intraoperative",1:"Postoperative")_" Occurrences entered for this case.",!!
K DIR,X S SRDD=$S(SRTYPE=10:130.13,1:130.22),DIR(0)=SRDD_","_$S(SRTYPE=10:3,1:5)_"O",DIR("A")="Enter a New "_$S(SRTYPE=10:"Intraoperative",1:"Postoperative")_" Occurrence" D ^DIR I $D(DUOUT)!(Y="") S SRSOUT=1 Q
K SRCOM,SRPOINT S SRPOINT=+Y,SRCOM=$P(Y,"^",2),SRNEW=1 D PRESS
; JAS - 05/02/13 - PATCH 177 - Rewrote filing logic.
I '$D(^SRF(SRTN,SRTYPE,0)) S ^SRF(SRTN,SRTYPE,0)="^"_SRTYPDD_"^^"
K DD,DA,DO,DIC,DINUM S X=SRCOM,DIC(0)="L",DLAYGO=SRDD,DA(1)=SRTN,DIC="^SRF("_SRTN_","_SRTYPE_"," D FILE^DICN S SRENTRY=+Y
N SRDA S SRDA=+Y
S SRICD="" I SRCOM["OTHER" D ICD I SRSOUT Q
S $P(^SRF(SRTN,SRTYPE,SRDA,0),"^",2)=SRPOINT
I $D(SRICD) S $P(^SRF(SRTN,SRTYPE,SRDA,0),"^",3)=SRICD
K SRDA
; END 177
Q
ICD I '$D(SRTN) Q
W !!,"Since you have selected one of the 'OTHER' occurrence categories, an ICD",!,"Diagnosis Code should be entered for this occurrence."
; JAS - 05/02/13 - PATCH 177 - Replaced DIR call with DIE
N DIE,DA,DR,SRDA
S DA(1)=SRTN,DA=+Y,SRDA=+Y,DIE="^SRF("_SRTN_","_SRTYPE_","
S DR=$S(SRTY="INTRAOPERATIVE":4,1:6)_"Select ICD Diagnosis Code "_$$ICDSTR^SROICD(SRTN) D ^DIE K DR,DA I $D(DUOUT) Q
I +X>0 S SRICD=+X,SRCOM=$P($$ICDC^SROICD(+X),"^",3)
; End 177
Q
DESC ; output occurrence category description when doing lookup
N SRX,SRY,SRZ
S SRX=0,SRY=Y F S SRX=$O(^SRO(136.5,SRY,1,SRX)) Q:'SRX S SRZ(SRX)=^SRO(136.5,SRY,1,SRX,0),SRZ(SRX,"F")="!?2"
I $O(SRZ(0)) D EN^DDIOL(.SRZ)
D EN^DDIOL(" ","","!")
Q
PRESS K DIR W ! S DIR(0)="FOA",DIR("A")="Press RETURN to continue: " D ^DIR K DIR I $D(DTOUT) S SRSOUT=1
Q
CO() ; called by screen on post-op occurrence category field
N SRSCR,SRTYPE,SRX S SRSCR="I '$P(^(0),U,2)" D Q SRSCR
.S SRX=$S($D(SRTN):SRTN,$D(DA(1)):DA(1),1:"") Q:'SRX
.S SRTYPE=$P($G(^SRF(SRX,"RA")),U,2)
.I SRTYPE'=""&(SRTYPE'="C") S SRSCR=SRSCR_"&($P(^(0),U,4)'="_"""Y"""_")"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROCMPS 3700 printed Dec 13, 2024@02:42:50 Page 2
SROCMPS ;BIR/MAM - ENTER/EDIT OCCURRENCES ;06/17/04 6:55 AM
+1 ;;3.0;Surgery;**14,32,38,95,102,116,125,142,177**;24 Jun 93;Build 89
INTRA SET SRTYPE=10
SET SRTY="INTRAOPERATIVE"
SET SRTYPDD="130.13A"
POST IF '$DATA(SRTYPE)
SET SRTYPE=16
SET SRTY="POSTOPERATIVE"
SET SRTYPDD="130.22A"
+1 WRITE @IOF,!
SET SRSOUT=0
IF '$DATA(SRTN)
SET SRTN1=1
DO ^SROPS
IF '$DATA(SRTN)
SET SRSOUT=1
GOTO END
+2 DO SRA^SROES
+3 SET SRSUPCPT=1
DO ^SROAUTL
SET SRNAME=$PIECE(VADM(1),"^")_" ("_VA("PID")_")"
SET SRLINE=""
FOR I=0:1:79
SET SRLINE=SRLINE_"-"
EDIT if SRSOUT
GOTO END
KILL SRCOMP
SET SRNEW=0
+1 IF '$ORDER(^SRF(SRTN,SRTYPE,0))
DO NEW
if SRSOUT
GOTO END
DO ^SROCMPED
GOTO EDIT
+2 DO HDR^SROAUTL
WRITE "Enter/Edit "_$SELECT(SRTYPE=10:"Intraoperative",1:"Postoperative")_" Occurrences",!
SET (COMP,CNT)=0
FOR
SET COMP=$ORDER(^SRF(SRTN,SRTYPE,COMP))
if 'COMP
QUIT
DO LIST
SEL WRITE !,"Select a number ("_$SELECT(CNT=1:1,1:"1-"_CNT)_"), or type 'NEW' to enter another occurrence: "
READ X:DTIME
IF '$TEST!("^"[X)
SET SRSOUT=1
GOTO END
+1 KILL SRENTRY
IF $EXTRACT(X)="N"!($EXTRACT(X)="n")
DO NEW
if SRSOUT
GOTO END
DO ^SROCMPED
GOTO EDIT
+2 IF '$DATA(SRCOMP(X))
WRITE !!,"Select the number corresponding to the occurrence you want to update, or",!,"enter 'NEW' to add another occurrence. ",!!,"Press RETURN to continue "
READ X:DTIME
GOTO EDIT
+3 if '$DATA(SRENTRY)
SET SRENTRY=$PIECE(SRCOMP(X),"^",3)
DO ^SROCMPED
GOTO EDIT
+4 QUIT
END if $DATA(SRTN)
DO EN^SROCCAT
DO EXIT^SROES
IF $DATA(SRTN1)
KILL SRTN,SRTN1
+1 IF 'SRSOUT
WRITE !!,"Press RETURN to continue "
READ X:DTIME
+2 if '$DATA(SROVER)
DO ^SRSKILL
WRITE @IOF
+3 QUIT
LIST ; list existing occurrences
+1 SET CNT=CNT+1
SET SRC(0)=^SRF(SRTN,SRTYPE,COMP,0)
SET SRCMP=$PIECE(SRC(0),"^")
SET SRCAT=$PIECE(SRC(0),"^",2)
SET SRCAT=$SELECT(SRCAT:$PIECE(^SRO(136.5,SRCAT,0),"^"),1:"NOT ENTERED")
SET SRCOMP(CNT)=SRCMP_"^"_SRCAT_"^"_COMP
+2 WRITE !,CNT_". ",?5,SRCMP,!,?5,"Category: "_SRCAT,!
+3 QUIT
NEW ; enter new occurrences
+1 DO HDR^SROAUTL
WRITE !
IF '$ORDER(^SRF(SRTN,SRTYPE,0))
WRITE !,"There are no "_$SELECT(SRTYPE=10:"Intraoperative",1:"Postoperative")_" Occurrences entered for this case.",!!
+2 KILL DIR,X
SET SRDD=$SELECT(SRTYPE=10:130.13,1:130.22)
SET DIR(0)=SRDD_","_$SELECT(SRTYPE=10:3,1:5)_"O"
SET DIR("A")="Enter a New "_$SELECT(SRTYPE=10:"Intraoperative",1:"Postoperative")_" Occurrence"
DO ^DIR
IF $DATA(DUOUT)!(Y="")
SET SRSOUT=1
QUIT
+3 KILL SRCOM,SRPOINT
SET SRPOINT=+Y
SET SRCOM=$PIECE(Y,"^",2)
SET SRNEW=1
DO PRESS
+4 ; JAS - 05/02/13 - PATCH 177 - Rewrote filing logic.
+5 IF '$DATA(^SRF(SRTN,SRTYPE,0))
SET ^SRF(SRTN,SRTYPE,0)="^"_SRTYPDD_"^^"
+6 KILL DD,DA,DO,DIC,DINUM
SET X=SRCOM
SET DIC(0)="L"
SET DLAYGO=SRDD
SET DA(1)=SRTN
SET DIC="^SRF("_SRTN_","_SRTYPE_","
DO FILE^DICN
SET SRENTRY=+Y
+7 NEW SRDA
SET SRDA=+Y
+8 SET SRICD=""
IF SRCOM["OTHER"
DO ICD
IF SRSOUT
QUIT
+9 SET $PIECE(^SRF(SRTN,SRTYPE,SRDA,0),"^",2)=SRPOINT
+10 IF $DATA(SRICD)
SET $PIECE(^SRF(SRTN,SRTYPE,SRDA,0),"^",3)=SRICD
+11 KILL SRDA
+12 ; END 177
+13 QUIT
ICD IF '$DATA(SRTN)
QUIT
+1 WRITE !!,"Since you have selected one of the 'OTHER' occurrence categories, an ICD",!,"Diagnosis Code should be entered for this occurrence."
+2 ; JAS - 05/02/13 - PATCH 177 - Replaced DIR call with DIE
+3 NEW DIE,DA,DR,SRDA
+4 SET DA(1)=SRTN
SET DA=+Y
SET SRDA=+Y
SET DIE="^SRF("_SRTN_","_SRTYPE_","
+5 SET DR=$SELECT(SRTY="INTRAOPERATIVE":4,1:6)_"Select ICD Diagnosis Code "_$$ICDSTR^SROICD(SRTN)
DO ^DIE
KILL DR,DA
IF $DATA(DUOUT)
QUIT
+6 IF +X>0
SET SRICD=+X
SET SRCOM=$PIECE($$ICDC^SROICD(+X),"^",3)
+7 ; End 177
+8 QUIT
DESC ; output occurrence category description when doing lookup
+1 NEW SRX,SRY,SRZ
+2 SET SRX=0
SET SRY=Y
FOR
SET SRX=$ORDER(^SRO(136.5,SRY,1,SRX))
if 'SRX
QUIT
SET SRZ(SRX)=^SRO(136.5,SRY,1,SRX,0)
SET SRZ(SRX,"F")="!?2"
+3 IF $ORDER(SRZ(0))
DO EN^DDIOL(.SRZ)
+4 DO EN^DDIOL(" ","","!")
+5 QUIT
PRESS KILL DIR
WRITE !
SET DIR(0)="FOA"
SET DIR("A")="Press RETURN to continue: "
DO ^DIR
KILL DIR
IF $DATA(DTOUT)
SET SRSOUT=1
+1 QUIT
CO() ; called by screen on post-op occurrence category field
+1 NEW SRSCR,SRTYPE,SRX
SET SRSCR="I '$P(^(0),U,2)"
Begin DoDot:1
+2 SET SRX=$SELECT($DATA(SRTN):SRTN,$DATA(DA(1)):DA(1),1:"")
if 'SRX
QUIT
+3 SET SRTYPE=$PIECE($GET(^SRF(SRX,"RA")),U,2)
+4 IF SRTYPE'=""&(SRTYPE'="C")
SET SRSCR=SRSCR_"&($P(^(0),U,4)'="_"""Y"""_")"
End DoDot:1
QUIT SRSCR
+5 QUIT
