source: WorldVistAEHR/trunk/r/SURGERY-SR/SROCMPS.m@ 1581

Last change on this file since 1581 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.3 KB
RevLine 
[613]1SROCMPS ;BIR/MAM - ENTER/EDIT OCCURRENCES ;06/17/04 6:55 AM
2 ;;3.0; Surgery ;**14,32,38,95,102,116,125,142**;24 Jun 93
3INTRA S SRTYPE=10,SRTY="INTRAOPERATIVE",SRTYPDD="130.13A"
4POST I '$D(SRTYPE) S SRTYPE=16,SRTY="POSTOPERATIVE",SRTYPDD="130.22A"
5 W @IOF,! S SRSOUT=0 I '$D(SRTN) S SRTN1=1 D ^SROPS I '$D(SRTN) S SRSOUT=1 G END
6 D SRA^SROES
7 S SRSUPCPT=1 D ^SROAUTL S SRNAME=$P(VADM(1),"^")_" ("_VA("PID")_")",SRLINE="" F I=0:1:79 S SRLINE=SRLINE_"-"
8EDIT G:SRSOUT END K SRCOMP S SRNEW=0
9 I '$O(^SRF(SRTN,SRTYPE,0)) D NEW G:SRSOUT END D ^SROCMPED G EDIT
10 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
11SEL 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
12 K SRENTRY I $E(X)="N"!($E(X)="n") D NEW G:SRSOUT END D ^SROCMPED G EDIT
13 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
14 S:'$D(SRENTRY) SRENTRY=$P(SRCOMP(X),"^",3) D ^SROCMPED G EDIT
15 Q
16END D:$D(SRTN) EN^SROCCAT,EXIT^SROES I $D(SRTN1) K SRTN,SRTN1
17 I 'SRSOUT W !!,"Press RETURN to continue " R X:DTIME
18 D:'$D(SROVER) ^SRSKILL W @IOF
19 Q
20LIST ; list existing occurrences
21 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
22 W !,CNT_". ",?5,SRCMP,!,?5,"Category: "_SRCAT,!
23 Q
24NEW ; enter new occurrences
25 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.",!!
26 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
27 K SRCOM,SRPOINT S SRPOINT=+Y,SRCOM=$P(Y,"^",2),SRNEW=1 D PRESS
28 S SRICD="" I SRCOM["OTHER" D ICD I SRSOUT Q
29 I '$D(^SRF(SRTN,SRTYPE,0)) S ^SRF(SRTN,SRTYPE,0)="^"_SRTYPDD_"^^"
30 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
31 S $P(^SRF(SRTN,SRTYPE,+Y,0),"^",2)=SRPOINT,$P(^SRF(SRTN,SRTYPE,+Y,0),"^",3)=SRICD
32 Q
33ICD W !!,"Since you have selected one of the 'OTHER' occurrence categories, an ICD",!,"Diagnosis Code should be entered for this occurrence."
34 S DIR(0)=$S(SRTY="INTRAOPERATIVE":"130.13,4",1:"130.22,6"),DIR("A")="Select ICD Diagnosis Code" D ^DIR K DIR I $D(DUOUT) Q
35 I +Y>0 S SRICD=+Y,SRCOM=$P($$ICDC^SROICD(+Y),"^",3)
36 Q
37DESC ; output occurrence category description when doing lookup
38 N SRX,SRY,SRZ
39 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"
40 I $O(SRZ(0)) D EN^DDIOL(.SRZ)
41 D EN^DDIOL(" ","","!")
42 Q
43PRESS K DIR W ! S DIR(0)="FOA",DIR("A")="Press RETURN to continue: " D ^DIR K DIR I $D(DTOUT) S SRSOUT=1
44 Q
45CO() ; called by screen on post-op occurrence category field
46 N SRSCR,SRTYPE,SRX S SRSCR="I '$P(^(0),U,2)" D Q SRSCR
47 .S SRX=$S($D(SRTN):SRTN,$D(DA(1)):DA(1),1:"") Q:'SRX
48 .S SRTYPE=$P($G(^SRF(SRX,"RA")),U,2)
49 .I SRTYPE'=""&(SRTYPE'="C") S SRSCR=SRSCR_"&($P(^(0),U,4)'="_"""Y"""_")"
50 Q
Note: See TracBrowser for help on using the repository browser.