- 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 Jan 18, 2025@03:44 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