$END TXT
$KID SR*3.0*183
**INSTALL NAME**
SR*3.0*183
"BLD",11135,0)
SR*3.0*183^SURGERY^0^3181210^y
"BLD",11135,1,0)
^^1^1^3181025^^
"BLD",11135,1,1,0)
Please refer to the patch description for details.
"BLD",11135,4,0)
^9.64PA^136^3
"BLD",11135,4,130,0)
130
"BLD",11135,4,130,2,0)
^9.641^130.18^2
"BLD",11135,4,130,2,130,0)
SURGERY  (File-top level)
"BLD",11135,4,130,2,130,1,0)
^9.6411^.027^1
"BLD",11135,4,130,2,130,1,.027,0)
CAMP LEJEUNE
"BLD",11135,4,130,2,130.18,0)
OTHER POSTOP DIAGS  (sub-file)
"BLD",11135,4,130,2,130.18,1,0)
^9.6411^12^1
"BLD",11135,4,130,2,130.18,1,12,0)
CAMP LEJEUNE
"BLD",11135,4,130,222)
y^y^p^^^^n^^n
"BLD",11135,4,130,224)

"BLD",11135,4,133.8,0)
133.8
"BLD",11135,4,133.8,2,0)
^9.641^133.801^1
"BLD",11135,4,133.8,2,133.801,0)
PATIENT  (sub-file)
"BLD",11135,4,133.8,2,133.801,1,0)
^9.6411^25^1
"BLD",11135,4,133.8,2,133.801,1,25,0)
CAMP LEJEUNE
"BLD",11135,4,133.8,222)
y^y^p^^^^n^^n
"BLD",11135,4,133.8,224)

"BLD",11135,4,136,0)
136
"BLD",11135,4,136,2,0)
^9.641^136.04^2
"BLD",11135,4,136,2,136,0)
SURGERY PROCEDURE/DIAGNOSIS CODES  (File-top level)
"BLD",11135,4,136,2,136,1,0)
^9.6411^.12^1
"BLD",11135,4,136,2,136,1,.12,0)
CAMP LEJEUNE
"BLD",11135,4,136,2,136.04,0)
OTHER POSTOP DIAGNOSIS CODES  (sub-file)
"BLD",11135,4,136,2,136.04,1,0)
^9.6411^.1^1
"BLD",11135,4,136,2,136.04,1,.1,0)
CAMP LEJEUNE
"BLD",11135,4,136,222)
y^y^p^^^^n^^n
"BLD",11135,4,136,224)

"BLD",11135,4,"APDD",130,130)

"BLD",11135,4,"APDD",130,130,.027)

"BLD",11135,4,"APDD",130,130.18)

"BLD",11135,4,"APDD",130,130.18,12)

"BLD",11135,4,"APDD",133.8,133.801)

"BLD",11135,4,"APDD",133.8,133.801,25)

"BLD",11135,4,"APDD",136,136)

"BLD",11135,4,"APDD",136,136,.12)

"BLD",11135,4,"APDD",136,136.04)

"BLD",11135,4,"APDD",136,136.04,.1)

"BLD",11135,4,"B",130,130)

"BLD",11135,4,"B",133.8,133.8)

"BLD",11135,4,"B",136,136)

"BLD",11135,6)
3^
"BLD",11135,6.3)
14
"BLD",11135,"ABPKG")
n
"BLD",11135,"KRN",0)
^9.67PA^779.2^20
"BLD",11135,"KRN",.4,0)
.4
"BLD",11135,"KRN",.401,0)
.401
"BLD",11135,"KRN",.402,0)
.402
"BLD",11135,"KRN",.403,0)
.403
"BLD",11135,"KRN",.5,0)
.5
"BLD",11135,"KRN",.84,0)
.84
"BLD",11135,"KRN",3.6,0)
3.6
"BLD",11135,"KRN",3.8,0)
3.8
"BLD",11135,"KRN",9.2,0)
9.2
"BLD",11135,"KRN",9.8,0)
9.8
"BLD",11135,"KRN",9.8,"NM",0)
^9.68A^15^13
"BLD",11135,"KRN",9.8,"NM",1,0)
SROANEST^^0^B56743268
"BLD",11135,"KRN",9.8,"NM",2,0)
SROCD^^0^B22774599
"BLD",11135,"KRN",9.8,"NM",3,0)
SROCD0^^0^B81782145
"BLD",11135,"KRN",9.8,"NM",4,0)
SROCD3^^0^B32220178
"BLD",11135,"KRN",9.8,"NM",5,0)
SROCD4^^0^B24773512
"BLD",11135,"KRN",9.8,"NM",8,0)
SROVER3^^0^B45495273
"BLD",11135,"KRN",9.8,"NM",9,0)
SROPCE^^0^B80465090
"BLD",11135,"KRN",9.8,"NM",10,0)
SROPCE1^^0^B53162491
"BLD",11135,"KRN",9.8,"NM",11,0)
SROPCEP^^0^B84721073
"BLD",11135,"KRN",9.8,"NM",12,0)
SROCD1^^0^B24301934
"BLD",11135,"KRN",9.8,"NM",13,0)
SRSWREQ^^0^B11627612
"BLD",11135,"KRN",9.8,"NM",14,0)
SROWL0^^0^B13754639
"BLD",11135,"KRN",9.8,"NM",15,0)
SRSRQST^^0^B38890100
"BLD",11135,"KRN",9.8,"NM","B","SROANEST",1)

"BLD",11135,"KRN",9.8,"NM","B","SROCD",2)

"BLD",11135,"KRN",9.8,"NM","B","SROCD0",3)

"BLD",11135,"KRN",9.8,"NM","B","SROCD1",12)

"BLD",11135,"KRN",9.8,"NM","B","SROCD3",4)

"BLD",11135,"KRN",9.8,"NM","B","SROCD4",5)

"BLD",11135,"KRN",9.8,"NM","B","SROPCE",9)

"BLD",11135,"KRN",9.8,"NM","B","SROPCE1",10)

"BLD",11135,"KRN",9.8,"NM","B","SROPCEP",11)

"BLD",11135,"KRN",9.8,"NM","B","SROVER3",8)

"BLD",11135,"KRN",9.8,"NM","B","SROWL0",14)

"BLD",11135,"KRN",9.8,"NM","B","SRSRQST",15)

"BLD",11135,"KRN",9.8,"NM","B","SRSWREQ",13)

"BLD",11135,"KRN",19,0)
19
"BLD",11135,"KRN",19.1,0)
19.1
"BLD",11135,"KRN",101,0)
101
"BLD",11135,"KRN",409.61,0)
409.61
"BLD",11135,"KRN",771,0)
771
"BLD",11135,"KRN",779.2,0)
779.2
"BLD",11135,"KRN",870,0)
870
"BLD",11135,"KRN",8989.51,0)
8989.51
"BLD",11135,"KRN",8989.52,0)
8989.52
"BLD",11135,"KRN",8994,0)
8994
"BLD",11135,"KRN","B",.4,.4)

"BLD",11135,"KRN","B",.401,.401)

"BLD",11135,"KRN","B",.402,.402)

"BLD",11135,"KRN","B",.403,.403)

"BLD",11135,"KRN","B",.5,.5)

"BLD",11135,"KRN","B",.84,.84)

"BLD",11135,"KRN","B",3.6,3.6)

"BLD",11135,"KRN","B",3.8,3.8)

"BLD",11135,"KRN","B",9.2,9.2)

"BLD",11135,"KRN","B",9.8,9.8)

"BLD",11135,"KRN","B",19,19)

"BLD",11135,"KRN","B",19.1,19.1)

"BLD",11135,"KRN","B",101,101)

"BLD",11135,"KRN","B",409.61,409.61)

"BLD",11135,"KRN","B",771,771)

"BLD",11135,"KRN","B",779.2,779.2)

"BLD",11135,"KRN","B",870,870)

"BLD",11135,"KRN","B",8989.51,8989.51)

"BLD",11135,"KRN","B",8989.52,8989.52)

"BLD",11135,"KRN","B",8994,8994)

"BLD",11135,"QDEF")
^^^^NO^^^^NO^^YES
"BLD",11135,"QUES",0)
^9.62^^
"BLD",11135,"REQB",0)
^9.611^5^4
"BLD",11135,"REQB",1,0)
SR*3.0*161^1
"BLD",11135,"REQB",3,0)
DG*5.3*914^1
"BLD",11135,"REQB",4,0)
SR*3.0*146^1
"BLD",11135,"REQB",5,0)
SR*3.0*184^1
"BLD",11135,"REQB","B","DG*5.3*914",3)

"BLD",11135,"REQB","B","SR*3.0*146",4)

"BLD",11135,"REQB","B","SR*3.0*161",1)

"BLD",11135,"REQB","B","SR*3.0*184",5)

"FIA",130)
SURGERY
"FIA",130,0)
^SRF(
"FIA",130,0,0)
130IP
"FIA",130,0,1)
y^y^p^^^^n^^n
"FIA",130,0,10)

"FIA",130,0,11)

"FIA",130,0,"RLRO")

"FIA",130,0,"VR")
3.0^SR
"FIA",130,130)
1
"FIA",130,130,.027)

"FIA",130,130.18)
1
"FIA",130,130.18,12)

"FIA",133.8)
SURGERY WAITING LIST
"FIA",133.8,0)
^SRO(133.8,
"FIA",133.8,0,0)
133.8IP
"FIA",133.8,0,1)
y^y^p^^^^n^^n
"FIA",133.8,0,10)

"FIA",133.8,0,11)

"FIA",133.8,0,"RLRO")

"FIA",133.8,0,"VR")
3.0^SR
"FIA",133.8,133.8)
1
"FIA",133.8,133.801)
1
"FIA",133.8,133.801,25)

"FIA",136)
SURGERY PROCEDURE/DIAGNOSIS CODES
"FIA",136,0)
^SRO(136,
"FIA",136,0,0)
136P
"FIA",136,0,1)
y^y^p^^^^n^^n
"FIA",136,0,10)

"FIA",136,0,11)

"FIA",136,0,"RLRO")

"FIA",136,0,"VR")
3.0^SR
"FIA",136,136)
1
"FIA",136,136,.12)

"FIA",136,136.04)
1
"FIA",136,136.04,.1)

"MBREQ")
0
"PKG",127,-1)
1^1
"PKG",127,0)
SURGERY^SR^SURGICAL DATA COLLECTION AND OPERATIONS SCHEDULING
"PKG",127,22,0)
^9.49I^1^1
"PKG",127,22,1,0)
3.0^3051119^2960829
"PKG",127,22,1,"PAH",1,0)
183^3181210^199
"PKG",127,22,1,"PAH",1,1,0)
^^1^1^3181210
"PKG",127,22,1,"PAH",1,1,1,0)
Please refer to the patch description for details.
"QUES","XPF1",0)
Y
"QUES","XPF1","??")
^D REP^XPDH
"QUES","XPF1","A")
Shall I write over your |FLAG| File
"QUES","XPF1","B")
YES
"QUES","XPF1","M")
D XPF1^XPDIQ
"QUES","XPF2",0)
Y
"QUES","XPF2","??")
^D DTA^XPDH
"QUES","XPF2","A")
Want my data |FLAG| yours
"QUES","XPF2","B")
YES
"QUES","XPF2","M")
D XPF2^XPDIQ
"QUES","XPI1",0)
YO
"QUES","XPI1","??")
^D INHIBIT^XPDH
"QUES","XPI1","A")
Want KIDS to INHIBIT LOGONs during the install
"QUES","XPI1","B")
NO
"QUES","XPI1","M")
D XPI1^XPDIQ
"QUES","XPM1",0)
PO^VA(200,:EM
"QUES","XPM1","??")
^D MG^XPDH
"QUES","XPM1","A")
Enter the Coordinator for Mail Group '|FLAG|'
"QUES","XPM1","B")

"QUES","XPM1","M")
D XPM1^XPDIQ
"QUES","XPO1",0)
Y
"QUES","XPO1","??")
^D MENU^XPDH
"QUES","XPO1","A")
Want KIDS to Rebuild Menu Trees Upon Completion of Install
"QUES","XPO1","B")
NO
"QUES","XPO1","M")
D XPO1^XPDIQ
"QUES","XPZ1",0)
Y
"QUES","XPZ1","??")
^D OPT^XPDH
"QUES","XPZ1","A")
Want to DISABLE Scheduled Options, Menu Options, and Protocols
"QUES","XPZ1","B")
YES
"QUES","XPZ1","M")
D XPZ1^XPDIQ
"QUES","XPZ2",0)
Y
"QUES","XPZ2","??")
^D RTN^XPDH
"QUES","XPZ2","A")
Want to MOVE routines to other CPUs
"QUES","XPZ2","B")
NO
"QUES","XPZ2","M")
D XPZ2^XPDIQ
"RTN")
13
"RTN","SROANEST")
0^1^B56743268^B54722958
"RTN","SROANEST",1,0)
SROANEST ;BIR/TJH - ANESTHESIA ENTRY ;01 Jun 2003
"RTN","SROANEST",2,0)
 ;;3.0;Surgery;**119,150,152,183**;24 Jun 93;Build 14
"RTN","SROANEST",3,0)
SINPUT ;
"RTN","SROANEST",4,0)
 N SRSTART
"RTN","SROANEST",5,0)
 S Z=$E($P(^SRF($S($D(SRTN):SRTN,1:DA(1)),0),"^",9),1,7),X=$S(X?1.4N.A!(X?1.2N1":"2N.A):Z_"@"_X,1:X) K %DT,Z S %DT="RTX" D ^%DT S X=Y K:Y<1 X
"RTN","SROANEST",6,0)
 I '$D(X),$G(SRFLAG)=1 D  K SRFLAG Q
"RTN","SROANEST",7,0)
 .W !!,"Check date format.",!,"     Examples of Valid Dates:",!,"       JAN 20 1957 or 20 JAN 57 or 1/20/57 or 012057",!,"       T   (for TODAY),  T+1 (for TOMORROW),  T+2,  T+7,  etc."
"RTN","SROANEST",8,0)
 .W !,"       T-1 (for YESTERDAY),  T-3W (for 3 WEEKS AGO), etc.",!,"     If the year is omitted, the computer uses CURRENT YEAR.  Two digit year"
"RTN","SROANEST",9,0)
 .W !,"       assumes no more than 20 years in the future, or 80 years in the past.",!,"     If only the time is entered, the current date is assumed."
"RTN","SROANEST",10,0)
 .W !,"     Follow the date with a time, such as JAN 20@10, T@10AM, 10:30, etc.",!,"     You may enter a time, such as NOON, MIDNIGHT or NOW."
"RTN","SROANEST",11,0)
 .W !,"     You may enter   NOW+3'  (for current date and time Plus 3 minutes",!,"       *Note--the Apostrophe following the number of minutes)"
"RTN","SROANEST",12,0)
 .W !,"     Time is REQUIRED in this response.",!,"     Enter the time a member of the Anesthesia staff begins preparing the",!,"     patient for surgery in the O.R. suite or if the care is interrupted, the"
"RTN","SROANEST",13,0)
 .W !,"     time the care resumes."
"RTN","SROANEST",14,0)
 Q:'$D(X)
"RTN","SROANEST",15,0)
 S SRSTART=$P($G(^SRF($S($D(SRTN):SRTN,1:DA(1)),.2)),"^",15)
"RTN","SROANEST",16,0)
 I SRSTART="" K SRFLAG Q
"RTN","SROANEST",17,0)
 I X<SRSTART W !!,"The time entered is before the 'TIME PAT IN HOLD AREA'.  Please check the",!,"DATE/TIME entered for this field." H 2
"RTN","SROANEST",18,0)
 K SRFLAG
"RTN","SROANEST",19,0)
 Q
"RTN","SROANEST",20,0)
STIME ;
"RTN","SROANEST",21,0)
 I '$D(X) Q
"RTN","SROANEST",22,0)
 N SRSPREC,SRPET,SRTIME,SRCRET
"RTN","SROANEST",23,0)
 S SRCRET=$$GET1^DIQ(130.213,DA(2)_","_DA(1)_",",1,"I")
"RTN","SROANEST",24,0)
 I SRCRET,(X>SRCRET) W !!,"Start time is after current end time. Please correct." K X Q
"RTN","SROANEST",25,0)
 S SRSPREC=$O(^SRF(DA(1),50,DA(2)),-1)
"RTN","SROANEST",26,0)
 I SRSPREC'=0 D
"RTN","SROANEST",27,0)
 .S SRPET=$$GET1^DIQ(130.213,SRSPREC_","_DA(1)_",",1,"I")
"RTN","SROANEST",28,0)
 .I SRPET="" W !!,"New start time entry not permitted until previous end time is entered." K X Q
"RTN","SROANEST",29,0)
 .I SRPET>X W !!,"Start time is prior to previous end time. Please correct." K X
"RTN","SROANEST",30,0)
 I $D(X),(DA(2)=1) S SRTIME(130,DA(1)_",",.21)=X D FILE^DIE("","SRTIME","^TMP(""SR"",$J)")
"RTN","SROANEST",31,0)
 Q
"RTN","SROANEST",32,0)
FINALT  ;
"RTN","SROANEST",33,0)
 N SRCST,SRLET,SRYN,SRSNREC,SRFDA,SRTIME,SRLREC,SRCON
"RTN","SROANEST",34,0)
 I $D(^SRF(DA(1),"CON")),$P(^("CON"),"^") S SRCON=$P(^SRF(DA(1),"CON"),"^")
"RTN","SROANEST",35,0)
 S SRCST=$$GET1^DIQ(130.213,DA(2)_","_DA(1)_",",.01,"I")
"RTN","SROANEST",36,0)
 I X<SRCST W !!,"End time prior to start time.  Please correct." K X Q
"RTN","SROANEST",37,0)
 S SRSNREC=$O(^SRF(DA(1),50,DA(2)))
"RTN","SROANEST",38,0)
 I SRSNREC'="B" Q
"RTN","SROANEST",39,0)
ASK W !!,"Does this entry complete all start and end times for this case?  (Y/N)//  " R SRYN:DTIME I '$T!(SRYN["^") S SRYN="N" Q
"RTN","SROANEST",40,0)
 S SRYN=$E(SRYN) I "YyNn?"'[SRYN W !,"Invalid response, please enter Yes or No. Use ? for help." G ASK
"RTN","SROANEST",41,0)
 I "?"[SRYN D HELP G ASK
"RTN","SROANEST",42,0)
 I ("Nn"[SRYN) S SRFDA(130,DA(1)_",",.214)="@" D FILE^DIE("","SRFDA","^TMP(""SR"",$J)") K SRFDA Q
"RTN","SROANEST",43,0)
 D CHKTIME
"RTN","SROANEST",44,0)
 I SRAFLAG=1 K SRAFLAG Q
"RTN","SROANEST",45,0)
 S SRLREC=$O(^SRF(DA(1),50,"B"),-1)
"RTN","SROANEST",46,0)
 I SRLREC'=DA(2) S SRLET=$$GET1^DIQ(130.213,SRLREC_","_DA(1)_",",1,"I")
"RTN","SROANEST",47,0)
 I SRLREC=DA(2) S SRLET=X
"RTN","SROANEST",48,0)
 S SRTIME(130,DA(1)_",",.24)=SRLET,SRTIME(130,DA(1)_",",.214)="1" D FILE^DIE("","SRTIME","^TMP(""SR"",$J)")
"RTN","SROANEST",49,0)
 K SRAFLAG
"RTN","SROANEST",50,0)
 Q:'$D(SRCON)
"RTN","SROANEST",51,0)
ASK2 ;
"RTN","SROANEST",52,0)
 W !,"Does this entry complete all start and end times for the concurrent",!,"case? (Y/N)//  " R SRYN:DTIME I '$T!(SRYN["^") S SRYN="N" Q
"RTN","SROANEST",53,0)
 I "?"[SRYN D HELP^SROCON D HELP G ASK2
"RTN","SROANEST",54,0)
 S SRYN=$E(SRYN) I "YyNn"'[SRYN W !,"Invalid response, please enter Yes or No. Use ? for help." G ASK2
"RTN","SROANEST",55,0)
 I ("Nn"[SRYN),(($P(^SRF(SRCON,.2),"^",17)=1)) S SRFDA(130,SRCON_",",.214)="@" D FILE^DIE("","SRFDA","^TMP(""SR"",$J)") K SRFDA Q
"RTN","SROANEST",56,0)
 S SRTIME(130,SRCON_",",.214)="1" D FILE^DIE("","SRTIME","^TMP(""SR"",$J)")
"RTN","SROANEST",57,0)
 Q
"RTN","SROANEST",58,0)
CHKTIME ;  verify blocks of time are valid
"RTN","SROANEST",59,0)
 N SRSREC,SRCST,SRCET,SRAFLAG1,SRSNREC,SRNST,SRLREC
"RTN","SROANEST",60,0)
 S SRAFLAG=0,SRSREC=0,SRAFLAG1=0
"RTN","SROANEST",61,0)
 F  S SRSREC=$O(^SRF(DA(1),50,SRSREC)) Q:'SRSREC!(SRAFLAG1=1)  D 
"RTN","SROANEST",62,0)
 .S SRCST=$$GET1^DIQ(130.213,SRSREC_","_DA(1)_",",.01,"I"),SRCET=$$GET1^DIQ(130.213,SRSREC_","_DA(1)_",",1,"I")
"RTN","SROANEST",63,0)
 .S SRLREC=$O(^SRF(DA(1),50,"B"),-1)
"RTN","SROANEST",64,0)
 .I (SRCET=""),(SRSREC'=SRLREC) W !!,"One or more time entries missing end time.  Please correct." S SRAFLAG=1,SRAFLAG1=1 Q
"RTN","SROANEST",65,0)
 .S SRSNREC=$O(^SRF(DA(1),50,SRSREC))
"RTN","SROANEST",66,0)
 .I SRSNREC="B" S SRAFLAG1=1 Q
"RTN","SROANEST",67,0)
 .S SRNST=$$GET1^DIQ(130.213,SRSNREC_","_DA(1)_",",.01,"I")
"RTN","SROANEST",68,0)
 .I SRNST<SRCET W !!,"Some time entries overlap.  Please correct." S SRAFLAG=1,SRAFLAG1=1 Q
"RTN","SROANEST",69,0)
 Q
"RTN","SROANEST",70,0)
CSET ;  caled by set xref of mult anes start and end times used for concurrent case anes field stuffing
"RTN","SROANEST",71,0)
 N SRSREC,SRCST,SRCET,SRTIME
"RTN","SROANEST",72,0)
 I $$GET1^DIQ(130,DA(1),.214,"I")'=1 Q
"RTN","SROANEST",73,0)
 S SRSREC=0
"RTN","SROANEST",74,0)
 F  S SRSREC=$O(^SRF(DA(1),50,SRSREC)) Q:'SRSREC  D
"RTN","SROANEST",75,0)
 .S:'$D(SRCST) SRCST=$$GET1^DIQ(130.213,SRSREC_","_DA(1)_",",.01,"I")
"RTN","SROANEST",76,0)
 .S SRCET=$$GET1^DIQ(130.213,SRSREC_","_DA(1)_",",1,"I")
"RTN","SROANEST",77,0)
 S SRTIME(130,DA(1)_",",.24)=SRCET,SRTIME(130,DA(1)_",",.21)=SRCST D FILE^DIE("","SRTIME","^TMP(""SR"",$J)")
"RTN","SROANEST",78,0)
 Q
"RTN","SROANEST",79,0)
DEL ; called by kill xref of mult anes start and end times
"RTN","SROANEST",80,0)
 I '$D(DA(2)) Q
"RTN","SROANEST",81,0)
 I (DA(2)=1),(D=.01) S SRFDA(130,DA(1)_",",.21)="@" D FILE^DIE("","SRFDA","^TMP(""SR"",$J)") K SRFDA
"RTN","SROANEST",82,0)
 I ($O(^SRF(DA(1),50,DA(2)))="B"),(D=1) S SRFDA(130,DA(1)_",",.24)="@",SRFDA(130,DA(1)_",",.214)="@" D FILE^DIE("","SRFDA","^TMP(""SR"",$J)") K SRFDA
"RTN","SROANEST",83,0)
 Q
"RTN","SROANEST",84,0)
HELP ;
"RTN","SROANEST",85,0)
 W !,"Enter ""Y"" only if the block of time entered is the final block of time for"
"RTN","SROANEST",86,0)
 W !,"this case.  If the block of time is not the final block, enter ""N""."
"RTN","SROANEST",87,0)
 Q
"RTN","SROANEST",88,0)
BILLTIME() ;  calculate total minutes for mult anes start and end times
"RTN","SROANEST",89,0)
 N SRSREC,SRCST,SRCET,SRTTIME
"RTN","SROANEST",90,0)
 S SRSREC=0,SRTTIME=0
"RTN","SROANEST",91,0)
 I $$GET1^DIQ(130,D0,.214,"I")'=1 Q SRTTIME
"RTN","SROANEST",92,0)
 I '$D(^SRF(D0,50)) Q SRTTIME
"RTN","SROANEST",93,0)
 F  S SRSREC=$O(^SRF(D0,50,SRSREC)) Q:'SRSREC  D
"RTN","SROANEST",94,0)
 .S SRCST=$$GET1^DIQ(130.213,SRSREC_","_D0_",",.01,"I"),SRCET=$$GET1^DIQ(130.213,SRSREC_","_D0_",",1,"I")
"RTN","SROANEST",95,0)
 .D CALC
"RTN","SROANEST",96,0)
 Q SRTTIME
"RTN","SROANEST",97,0)
CALC ; calculate minutes between start and end times
"RTN","SROANEST",98,0)
 N SRETH,SRDHRS,SRSHR,SREHR,SRSMN,SREMN,SRSTH,X1,X2,Y,%H
"RTN","SROANEST",99,0)
 S X1=SRCST,X2=0 D C^%DTC S SRSTH=%H
"RTN","SROANEST",100,0)
 S X1=SRCET,X2=0 D C^%DTC S SRETH=%H
"RTN","SROANEST",101,0)
 S SRDHRS=(SRETH-SRSTH)*24
"RTN","SROANEST",102,0)
 S SRSHR=$E(($P(SRCST_"0",".",2)),1,2)
"RTN","SROANEST",103,0)
 S SREHR=$E(($P(SRCET_"0",".",2)),1,2)
"RTN","SROANEST",104,0)
 I SREHR<SRSHR S SREHR=SREHR+24,SRDHRS=SRDHRS-24
"RTN","SROANEST",105,0)
 S SRSMN=$E(($P(SRCST_"00",".",2)),3,4)
"RTN","SROANEST",106,0)
 S SREMN=$E(($P(SRCET_"00",".",2)),3,4)
"RTN","SROANEST",107,0)
 I SREMN<SRSMN S SREMN=SREMN+60,SREHR=SREHR-1
"RTN","SROANEST",108,0)
 S Y=(SRDHRS*60)+((SREHR-SRSHR)*60)+(SREMN-SRSMN)
"RTN","SROANEST",109,0)
 S SRTTIME=SRTTIME+Y
"RTN","SROANEST",110,0)
 Q
"RTN","SROANEST",111,0)
ANESTIME(SRDFN,SRFDATE,SRTDATE) ; API to return multiple anesthesia records and times
"RTN","SROANEST",112,0)
 ; pwc Camp Lejeune added SRCLV SR*3*183
"RTN","SROANEST",113,0)
 N SRCASE,SRREC,SRCNT,SRNON,SRX,SRDATE,SRRES,SRSC,SRCV,SRQO,SRIR,SREC,SRMST,SRHNC,SRAO,SRSREC,SRCST,SRCET,SRTTIME,SR,SRDIAG,SRSHAD,SRCLV
"RTN","SROANEST",114,0)
 S (SRREC,SRCNT,SRRES)=0
"RTN","SROANEST",115,0)
 I '$D(SRDFN)!'$D(SRFDATE) Q -1
"RTN","SROANEST",116,0)
 I '$D(SRTDATE) S SRTDATE=SRFDATE
"RTN","SROANEST",117,0)
 I '$D(^SRF("B",SRDFN)) Q 0
"RTN","SROANEST",118,0)
 S SRFDATE=$P(SRFDATE,"."),SRTDATE=$P(SRTDATE,".")
"RTN","SROANEST",119,0)
 F  S SRREC=$O(^SRF("B",SRDFN,SRREC)) Q:'SRREC  S SRCNT=SRCNT+1,SRCASE(SRCNT)=SRREC
"RTN","SROANEST",120,0)
 S SRREC=0
"RTN","SROANEST",121,0)
 F  S SRREC=$O(SRCASE(SRREC)) Q:'SRREC  D
"RTN","SROANEST",122,0)
 .S SRCASE=SRCASE(SRREC)
"RTN","SROANEST",123,0)
 .S SRNON=$S($P($G(^SRF(SRCASE,"NON")),"^")="Y":1,1:0)
"RTN","SROANEST",124,0)
 .I 'SRNON S SRX=$G(^SRF(SRCASE,.2)),SRDATE=$P(SRX,"^",10)
"RTN","SROANEST",125,0)
 .I SRNON S SRX=$G(^SRF(SRCASE,"NON")),SRDATE=$P(SRX,"^",4)
"RTN","SROANEST",126,0)
 .S SRDATE=$P(SRDATE,".")
"RTN","SROANEST",127,0)
 .I (SRDATE<SRFDATE)!(SRDATE>SRTDATE) K SRCASE(SRREC) Q
"RTN","SROANEST",128,0)
 S SRREC=0
"RTN","SROANEST",129,0)
 F  S SRREC=$O(SRCASE(SRREC)) Q:'SRREC  D
"RTN","SROANEST",130,0)
 .S SRCASE=SRCASE(SRREC)
"RTN","SROANEST",131,0)
 .I $$GET1^DIQ(130,SRCASE,.214,"I")'=1 S SRRES=-2 Q
"RTN","SROANEST",132,0)
 .S SRDIAG=$P($G(^SRO(136,SRCASE,0)),"^",3)
"RTN","SROANEST",133,0)
 .I 'SRDIAG S SRDIAG=$P($G(^SRF(SRCASE,34)),"^",2)
"RTN","SROANEST",134,0)
 . ; pwc Camp Lejeune added SRCLV SR*3*183
"RTN","SROANEST",135,0)
 .S (SRAO,SREC,SRHNC,SRIR,SRMST,SRSHAD,SRCLV)=0
"RTN","SROANEST",136,0)
 .S SR(0)=$G(^SRF(SRCASE,0))
"RTN","SROANEST",137,0)
 . ;pwc Camp Lejeune added SRCLV SR*3*183
"RTN","SROANEST",138,0)
 .S SRSC=$P(SR(0),"^",16),SRAO=$P(SR(0),"^",17),SRIR=$P(SR(0),"^",18),SREC=$P(SR(0),"^",19),SRMST=$P(SR(0),"^",22),SRHNC=$P(SR(0),"^",23),SRCV=$P(SR(0),"^",24),SRSHAD=$P(SR(0),"^",25),SRCLV=$P(SR(0),"^",27)
"RTN","SROANEST",139,0)
 .I '$D(^SRF(SRCASE,50)) S:SRRES'=1 SRRES=-2 Q
"RTN","SROANEST",140,0)
 .S SRRES=1,SRREC=0
"RTN","SROANEST",141,0)
 .F  S SRREC=$O(^SRF(SRCASE,50,SRREC)) Q:(SRREC="B")!(SRREC="")  D
"RTN","SROANEST",142,0)
 ..S SRCST=$$GET1^DIQ(130.213,SRREC_","_SRCASE_",",.01,"I"),SRCET=$$GET1^DIQ(130.213,SRREC_","_SRCASE_",",1,"I")
"RTN","SROANEST",143,0)
 ..I 'SRCET K ^TMP("SRANES",$J,SRCASE) S SRRES=-2,SRREC="" Q
"RTN","SROANEST",144,0)
 ..S SRTTIME=0 D CALC
"RTN","SROANEST",145,0)
 ..S ^TMP("SRANES",$J,SRCASE,SRCST,SRCET)=SRDFN_"^"_SRTTIME_"^"_SRDIAG_"^"_SRSC_"^"_SRCV_"^"_SRAO_"^"_SRIR_"^"_SREC_"^"_SRMST_"^"_SRHNC_"^"_SRSHAD_"^"_SRCLV
"RTN","SROANEST",146,0)
 Q SRRES
"RTN","SROCD")
0^2^B22774599^B20552354
"RTN","SROCD",1,0)
SROCD ;BIR/ADM - CASE CODING IN SURGERY PROCEDURE/DIAGNOSIS CODES FILE ;06 Nov 2018  9:20 AM
"RTN","SROCD",2,0)
 ;;3.0;Surgery;**142,152,159,183**;24 Jun 93;Build 14
"RTN","SROCD",3,0)
 I '$D(SRSITE) D ^SROVAR I '$D(SRSITE) S XQUIT="" Q
"RTN","SROCD",4,0)
 I '$G(SRTN) D ^SROPS1 I '$D(SRTN) S XQUIT="" Q
"RTN","SROCD",5,0)
BEG N S,SR2,SRCMOD,SRDES,SRDX,SREDIT,SRHDR,SRMOD,SRNM,SRPROC,SRS,SRSEL,SRTXT
"RTN","SROCD",6,0)
 S (SREDIT,SRMOD,SRSOUT,SRS,SR2)=0 I $P($G(^SRF(SRTN,.2)),"^",3) S SRS=1
"RTN","SROCD",7,0)
 S S(0)=^SRF(SRTN,0),Y=$P(S(0),"^",9),SRDATE=Y D D^DIQ S SRSDATE=Y,DFN=$P(S(0),"^") D DEM^VADPT S SRNM=VADM(1)_"  ("_VA("PID")_")"
"RTN","SROCD",8,0)
 S SRNON=$S($P($G(^SRF(SRTN,"NON")),"^")="Y":1,1:0)
"RTN","SROCD",9,0)
 I '$D(^SRO(136,SRTN)) D ^SROCD1
"RTN","SROCD",10,0)
 I $P($G(^SRO(136,SRTN,10)),"^") D SURE I 'SREDIT Q
"RTN","SROCD",11,0)
EDIT D ^SROCD2 I SRSOUT!SREDIT G END
"RTN","SROCD",12,0)
 D EDIT
"RTN","SROCD",13,0)
 Q
"RTN","SROCD",14,0)
SURE D HDR K DIR
"RTN","SROCD",15,0)
 S DIR("A",1)="Coding for this case has been completed "_$S($P(^SRF(SRTN,0),"^",15):"and",1:"but not")_" sent to PCE."
"RTN","SROCD",16,0)
 S DIR("A",2)="",DIR("A")="Are you sure you want to edit this case",DIR(0)="Y",DIR("B")="NO" D ^DIR K DIR
"RTN","SROCD",17,0)
 I Y S SREDIT=1 M ^TMP("SRED1",$J,SRTN)=^SRO(136,SRTN) Q
"RTN","SROCD",18,0)
END S SROERR=SRTN D ^SROERR0,^SRSKILL
"RTN","SROCD",19,0)
 K ADCNT,SRCOMMA,SRDXCNT,SROCNTR,SROCPT2,SROERR,SROFLG,SRTMP,SRICD9,SRDIAGS,SRASDX,SRMSG,SRADX,SRPADX,SRODIR,REC,SRDIRX,SRADIAG,SRDX,SRDX1,SRDX2,SROICD,SUB4
"RTN","SROCD",20,0)
 W @IOF K ^TMP("SRED1",$J)
"RTN","SROCD",21,0)
 Q
"RTN","SROCD",22,0)
HDR W @IOF,!,SRNM_"        Case #"_SRTN,!
"RTN","SROCD",23,0)
 S SRPROC=$P(^SRF(SRTN,"OP"),"^") D BRK W $P(SRSDATE,"@")_"   "_SRHDR(1)
"RTN","SROCD",24,0)
 I $D(SRHDR(2)) W !,?15,SRHDR(2) I $D(SRHDR(3)) W !,?15,SRHDR(3)
"RTN","SROCD",25,0)
 W ! F I=1:1:80 W "-"
"RTN","SROCD",26,0)
 Q
"RTN","SROCD",27,0)
BRK ; break procedure if greater than 65 characters
"RTN","SROCD",28,0)
 I $L(SRPROC)<66 S SRHDR(1)=SRPROC Q
"RTN","SROCD",29,0)
 S X=SRPROC,K=1 F  D  I $L(X)<66 S SRHDR(K)=X Q
"RTN","SROCD",30,0)
 .F I=0:1:64 S J=65-I,Y=$E(X,J) I Y=" " S SRHDR(K)=$E(X,1,J-1),X=$E(X,J+1,$L(X)) S K=K+1 Q
"RTN","SROCD",31,0)
 Q
"RTN","SROCD",32,0)
OSCEI ; update SC/EI info on other diagnosis
"RTN","SROCD",33,0)
 K DA,DIE,DR,DIR W !!,"Please supply the following required information related to this diagnosis:",!
"RTN","SROCD",34,0)
 S SRDR="",SRQ=0 S DA=$P(SRSEL(SRDA),U),DA(1)=SRTN D  I SRQ Q
"RTN","SROCD",35,0)
 .I $D(SRCL(3)) D SC I SRQ Q
"RTN","SROCD",36,0)
 .I $D(SRCL(7)) D CV I SRQ Q
"RTN","SROCD",37,0)
 .I $D(SRCL(1)) D AO I SRQ Q
"RTN","SROCD",38,0)
 .I $D(SRCL(2)) D IR I SRQ Q
"RTN","SROCD",39,0)
 .I $D(SRCL(4)) D EC I SRQ Q
"RTN","SROCD",40,0)
 .I $D(SRCL(8)) D PRJ I SRQ Q
"RTN","SROCD",41,0)
 .I $D(SRCL(5)) D MST I SRQ Q
"RTN","SROCD",42,0)
 .I $D(SRCL(6)) D HNC I SRQ Q
"RTN","SROCD",43,0)
 .I $D(SRCL(9)) D CLV I SRQ Q       ; pwc Camp Lejeune SR*3*183
"RTN","SROCD",44,0)
 K DIR S DA=$P(SRSEL(SRDA),U),DA(1)=SRTN,DIE="^SRO(136,SRTN,4,",DR=SRDR D ^DIE K DA,DIE,DR,SRDR
"RTN","SROCD",45,0)
 Q
"RTN","SROCD",46,0)
SC S DIR("A")="Treatment related to Service Connected condition (Y/N)",DIR(0)="136.04,.02" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRQ=1 Q
"RTN","SROCD",47,0)
 I X=""!(X="@") W !,$C(7),?15,"Enter YES or NO." G SC
"RTN","SROCD",48,0)
 S SRCL(3)=Y,SRDR=$G(SRDR)_".02////"_SRCL(3)_";"
"RTN","SROCD",49,0)
 Q
"RTN","SROCD",50,0)
CV N SRCVD S SRCVD=$P($G(^SRO(136,DA(1),4,DA,0)),"^",8),DIR("B")=$S(SRCVD=0:"NO",1:"YES")
"RTN","SROCD",51,0)
 S DIR("A")="Treatment related to Combat (Y/N)",DIR(0)="136.04,.08" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRQ=1 Q
"RTN","SROCD",52,0)
 I X=""!(X="@") W !,$C(7),?15,"Enter YES or NO." G CV
"RTN","SROCD",53,0)
 S SRCL(7)=Y,SRDR=SRDR_".08////"_SRCL(7)_";"
"RTN","SROCD",54,0)
 Q
"RTN","SROCD",55,0)
AO S DIR("A")="Treatment related to Agent Orange Exposure (Y/N)",DIR(0)="136.04,.03" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRQ=1 Q
"RTN","SROCD",56,0)
 I X=""!(X="@") W !,$C(7),?15,"Enter YES or NO." G AO
"RTN","SROCD",57,0)
 S SRCL(1)=Y,SRDR=SRDR_".03////"_SRCL(1)_";"
"RTN","SROCD",58,0)
 Q
"RTN","SROCD",59,0)
IR S DIR("A")="Treatment related to Ionizing Radiation Exposure (Y/N)",DIR(0)="136.04,.04" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRQ=1 Q
"RTN","SROCD",60,0)
 I X=""!(X="@") W !,$C(7),?15,"Enter YES or NO." G IR
"RTN","SROCD",61,0)
 S SRCL(2)=Y,SRDR=SRDR_".04////"_SRCL(2)_";"
"RTN","SROCD",62,0)
 Q
"RTN","SROCD",63,0)
EC S DIR("A")="Treatment related to SW Asia (Y/N)",DIR(0)="136.04,.07" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRQ=1 Q
"RTN","SROCD",64,0)
 I X=""!(X="@") W !,$C(7),?15,"Enter YES or NO." G EC
"RTN","SROCD",65,0)
 S SRCL(4)=Y,SRDR=SRDR_".07////"_SRCL(4)_";"
"RTN","SROCD",66,0)
 Q
"RTN","SROCD",67,0)
PRJ S DIR("A")="Treatment related to PROJ 112/SHAD (Y/N)",DIR(0)="136.04,.09" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRQ=1 Q
"RTN","SROCD",68,0)
 I X=""!(X="@") W !,$C(7),?15,"Enter YES or NO." G PRJ
"RTN","SROCD",69,0)
 S SRCL(8)=Y,SRDR=SRDR_".09////"_SRCL(8)_";"
"RTN","SROCD",70,0)
 Q
"RTN","SROCD",71,0)
MST S DIR("A")="Treatment related to Military Sexual Trauma (Y/N)",DIR(0)="136.04,.05" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRQ=1 Q
"RTN","SROCD",72,0)
 I X=""!(X="@") W !,$C(7),?15,"Enter YES or NO." G MST
"RTN","SROCD",73,0)
 S SRCL(5)=Y,SRDR=SRDR_".05////"_SRCL(5)_";"
"RTN","SROCD",74,0)
 Q
"RTN","SROCD",75,0)
HNC S DIR("A")="Treatment related to Head and/or Neck Cancer (Y/N)",DIR(0)="136.04,.06" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRQ=1 Q
"RTN","SROCD",76,0)
 I X=""!(X="@") W !,$C(7),?15,"Enter YES or NO." G HNC
"RTN","SROCD",77,0)
 S SRCL(6)=Y,SRDR=SRDR_".06////"_SRCL(6)_";"
"RTN","SROCD",78,0)
 Q
"RTN","SROCD",79,0)
 ; pwc Camp Lejeune SR*3*183
"RTN","SROCD",80,0)
CLV S DIR("A")="Treatment related to Camp Lejeune (Y/N)",DIR(0)="136.04,.1" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRQ=1 Q
"RTN","SROCD",81,0)
 I X=""!(X="@") W !,$C(7),?15,"Enter YES or NO." G CLV
"RTN","SROCD",82,0)
 S SRCL(9)=Y,SRDR=SRDR_".1////"_SRCL(9)_";"
"RTN","SROCD",83,0)
 Q
"RTN","SROCD0")
0^3^B81782145^B65638166
"RTN","SROCD0",1,0)
SROCD0 ;BIR/ADM - CASE CODING INPUT/EDIT ;26 Sep 2018  1:55 PM
"RTN","SROCD0",2,0)
 ;;3.0;Surgery;**142,152,159,177,183**;24 Jun 93;Build 14
"RTN","SROCD0",3,0)
 ;;
"RTN","SROCD0",4,0)
 ; Reference to CL^SDCO21 supported by DBIA #406
"RTN","SROCD0",5,0)
 ;;
"RTN","SROCD0",6,0)
PRDX ; edit Principal Postop Diagnosis
"RTN","SROCD0",7,0)
 N SRDUP,SRDXY,SRI,SROLD,ENVARR,SCEC,SRNEW,SRNUM S SCEC=$$SCEC()
"RTN","SROCD0",8,0)
 S (SROLD,X)=$P(^SRO(136,SRTN,0),"^",3),SRDIAG="NOT ENTERED" I 'X D PDXEN Q
"RTN","SROCD0",9,0)
 I X S Y=$$ICD^SROICD(SRTN,X),SRNUM=$P(Y,U,2),SRDES=$P(Y,U,4),SRDIAG=SRNUM_"  "_SRDES
"RTN","SROCD0",10,0)
 W !,"Principal Postop Diagnosis:",!!,?5,"ICD"_$$ICD910^SROICD(SRTN)_" Code: "_SRDIAG D:SCEC
"RTN","SROCD0",11,0)
 .D GETS^DIQ(136,SRTN_",",".04:.12","E","ENVARR")
"RTN","SROCD0",12,0)
 .I $D(ENVARR(136,SRTN_",",.04,"E")) D
"RTN","SROCD0",13,0)
 ..N SRCOLSPN S SRCOLSPN=13 W !
"RTN","SROCD0",14,0)
 ..I $D(SRCL(3)) W ?SRCOLSPN,"SC:",$E(ENVARR(136,SRTN_",",.04,"E")) S SRCOLSPN=SRCOLSPN+8
"RTN","SROCD0",15,0)
 ..I $D(SRCL(7)) W ?SRCOLSPN,"CV:",$E(ENVARR(136,SRTN_",",.1,"E")) S SRCOLSPN=SRCOLSPN+8
"RTN","SROCD0",16,0)
 ..I $D(SRCL(1)) W ?SRCOLSPN,"AO:",$E(ENVARR(136,SRTN_",",.05,"E")) S SRCOLSPN=SRCOLSPN+8
"RTN","SROCD0",17,0)
 ..I $D(SRCL(2)) W ?SRCOLSPN,"IR:",$E(ENVARR(136,SRTN_",",.06,"E")) S SRCOLSPN=SRCOLSPN+8
"RTN","SROCD0",18,0)
 ..I $D(SRCL(4)) W ?SRCOLSPN,"SWAC:",$E(ENVARR(136,SRTN_",",.07,"E")) S SRCOLSPN=SRCOLSPN+8
"RTN","SROCD0",19,0)
 ..I $D(SRCL(8)) W ?SRCOLSPN,"SHAD:",$E(ENVARR(136,SRTN_",",.11,"E")) S SRCOLSPN=SRCOLSPN+8
"RTN","SROCD0",20,0)
 ..I $D(SRCL(5)) W ?SRCOLSPN,"MST:",$E(ENVARR(136,SRTN_",",.08,"E")) S SRCOLSPN=SRCOLSPN+8
"RTN","SROCD0",21,0)
 ..I $D(SRCL(6)) W ?SRCOLSPN,"H&N:",$E(ENVARR(136,SRTN_",",.09,"E")) S SRCOLSPN=SRCOLSPN+8
"RTN","SROCD0",22,0)
 ..I $D(SRCL(9)) W ?SRCOLSPN,"CLV:" D  S SRCOLSPN=SRCOLSPN+8       ;pwc Camp Lejeune SR*3*183
"RTN","SROCD0",23,0)
 ... ; display from file 136 if available, otherwise lookup answer from surgery file SR*3*183
"RTN","SROCD0",24,0)
 ... W:$E(ENVARR(136,SRTN_",",.12,"E"))'="" $E(ENVARR(136,SRTN_",",.12,"E"))
"RTN","SROCD0",25,0)
 ... I $E(ENVARR(136,SRTN_",",.12,"E"))="" N SRCLVD S SRCLVD=$$GET1^DIQ(130,$P(SR(0),"^",1)_",",.027,"","SRERR") W $E(SRCLVD,1) D
"RTN","SROCD0",26,0)
 ....; file SRCLVD variable back into file 136
"RTN","SROCD0",27,0)
 ....N SRFDA,SRMSG S SRFDA(136,SRTN_",",.12)=$S(SRCLVD="YES":1,1:0) D FILE^DIE("E","SRFDA","SRMSG")
"RTN","SROCD0",28,0)
 K DIR S DIR(0)="SO^1:Update Principal Postop Diagnosis Code;2:Update Service Connected/Environmental Indicators only"
"RTN","SROCD0",29,0)
 S DIR("A")="Enter selection (1 or 2)",DIR("B")=1 D ^DIR I $D(DTOUT)!$D(DUOUT)!'Y Q
"RTN","SROCD0",30,0)
 S SRDXY=Y I SRDXY=1 D PDXEN Q
"RTN","SROCD0",31,0)
 I SRDXY=2 D PSCEI
"RTN","SROCD0",32,0)
 Q
"RTN","SROCD0",33,0)
PRESS W ! K DIR S DIR("A")="Press Enter/Return key to continue ",DIR(0)="FOA" D ^DIR K DIR
"RTN","SROCD0",34,0)
 Q
"RTN","SROCD0",35,0)
PDXEN ;
"RTN","SROCD0",36,0)
 ; JAS - 6/19/13 - Patch 177 - modifications to correct ^DIR incompatibility with ICD-10 Code Set Versioning Utility
"RTN","SROCD0",37,0)
 N X,Y,SRPRMT S SRPRMT="Principal Postop Diagnosis Code ",SRDEF=$P($G(SROICD),"-",1)
"RTN","SROCD0",38,0)
 D ICDSRCH^SROICD
"RTN","SROCD0",39,0)
 I $G(X)="^" K X Q
"RTN","SROCD0",40,0)
 I $G(X)="" W !,"This is a required entry." G PDXEN
"RTN","SROCD0",41,0)
 I $G(X)="@" W !!," Deletion of the Principal Postop Diagnosis Code is not allowed! ??" G PDXEN
"RTN","SROCD0",42,0)
 S SRNEW=+$G(Y)
"RTN","SROCD0",43,0)
 ; End 177
"RTN","SROCD0",44,0)
 S (SRDUP,SRI)=0 I SRNEW=SROLD Q
"RTN","SROCD0",45,0)
 I SRNEW,SRNEW'=SROLD F  S SRI=$O(SRADIAG(SRI)) Q:'SRI  I SRADIAG(SRI)=SRNEW S SRDUP=1 Q
"RTN","SROCD0",46,0)
 I SRDUP D DUP,HDR^SROCD G PDXEN
"RTN","SROCD0",47,0)
 K DR,DIE,DA S DIE=136,DA=SRTN,DR=".03////"_SRNEW D ^DIE K DR,DIE I $D(Y) Q
"RTN","SROCD0",48,0)
 I SRNEW'=SROLD S X=SROLD D PRINASOD^SROCDX2
"RTN","SROCD0",49,0)
 D REMIND
"RTN","SROCD0",50,0)
PSCEI I $P(^SRO(136,SRTN,0),"^",3) D
"RTN","SROCD0",51,0)
 .I SCEC D SCEI^SROCD3 K SRCL Q
"RTN","SROCD0",52,0)
 .W !!,"  >>>  No SC/EI information required for this patient.  <<<" D PRESS
"RTN","SROCD0",53,0)
 Q
"RTN","SROCD0",54,0)
POTH W !,"Other Procedures:",!
"RTN","SROCD0",55,0)
 N SRSHT,SRNEW,SROLD,SRPOTH,CNT,OTHER,SROPY K SRSEL S CNT=1,OTH=0 F  S OTH=$O(^SRO(136,SRTN,3,OTH)) Q:'OTH!(SRSOUT)  D
"RTN","SROCD0",56,0)
 .S X=$P($G(^SRO(136,SRTN,3,OTH,0)),U),CPT1=""
"RTN","SROCD0",57,0)
 .I X S CPT1=X,Y=$$CPT^ICPTCOD(X,$P($G(^SRF(SRTN,0)),"^",9)),SRCPT=$P(Y,U,2),SRSHT=$P(Y,U,3),Y=SRCPT,SRDA=OTH D SSOTH^SROCPT0 S SRCPT=Y,CPT=SRCPT_"  "_SRSHT
"RTN","SROCD0",58,0)
 .W !,CNT_". CPT Code: "_CPT
"RTN","SROCD0",59,0)
 .S SRSEL(CNT)=OTH_"^CPT Code: "_CPT_"^"_CPT1_"^"_SRCPT
"RTN","SROCD0",60,0)
 .D OTHADXD^SROCDX1
"RTN","SROCD0",61,0)
 .S CNT=CNT+1
"RTN","SROCD0",62,0)
 W !,CNT_". Enter NEW Other Procedure Code",! K DIR S DIR("A")="Enter selection",DIR(0)="NO^1:"_CNT D ^DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1 Q
"RTN","SROCD0",63,0)
 I 'Y,$$ADCHK D DELWRN^SROCDX2,PRESS Q
"RTN","SROCD0",64,0)
 Q:'Y  S (OTHCNT,SRDA)=Y W !! I SRDA<CNT D  G PH
"RTN","SROCD0",65,0)
 .D HDR^SROCD,OTHCPTD^SROCDX,OTHADX^SROCDX1
"RTN","SROCD0",66,0)
 .K DIR S DIR(0)="SO^1:Update Other Procedure CPT Code;2:Update Associated Diagnoses"
"RTN","SROCD0",67,0)
 .S DIR("A")="Enter selection (1 or 2)",DIR("B")=1 D ^DIR I $D(DTOUT)!$D(DUOUT)!'Y Q
"RTN","SROCD0",68,0)
 .S SROPY=Y I SROPY=1 D OPEN Q
"RTN","SROCD0",69,0)
 .I SROPY=2 D OASS
"RTN","SROCD0",70,0)
 S SRDUP=0 K DIR S DIR("A")="Enter new OTHER PROCEDURE CPT code",DIR(0)="136.03,.01" D ^DIR K DIR S SRNEW=+$G(Y) I $D(DTOUT)!$D(DUOUT)!($G(Y)="") G PH
"RTN","SROCD0",71,0)
 S SRX=0 F  S SRX=$O(^SRO(136,SRTN,3,SRX)) Q:'SRX  I $P($G(^SRO(136,SRTN,3,SRX,0)),U)=SRNEW S SRDUP=1 Q
"RTN","SROCD0",72,0)
 K DD,DO S SRDICN=1,DIC="^SRO(136,SRTN,3,",X=SRNEW,DIC(0)="L" D FILE^DICN K DIC,DD,DO,SRDICN I +Y<0 Q
"RTN","SROCD0",73,0)
 K DA S (SRPOTH,DA)=+Y,DA(1)=SRTN D OPROC^SROMOD0 K DA
"RTN","SROCD0",74,0)
 S SRDA=CNT,OTHER=SRNEW D COTHADX^SROCDX
"RTN","SROCD0",75,0)
PH D HDR^SROCD D POTH
"RTN","SROCD0",76,0)
 Q
"RTN","SROCD0",77,0)
OPEN N SRDIRED W ! S SROLD=$P(SRSEL(SRDA),U,3),SRDIE=1,SRDIRED=0 K DA,DIE,DIR,DR
"RTN","SROCD0",78,0)
 S DA=$P(SRSEL(SRDA),U),DA(1)=SRTN,DIE="^SRO(136,SRTN,3,",DR=".01T" D ^DIE K DIE,DR,SRDIE Q:$D(Y)
"RTN","SROCD0",79,0)
 I 'SRDIRED K DA Q
"RTN","SROCD0",80,0)
 D OPROC^SROMOD0
"RTN","SROCD0",81,0)
 S X=$P($G(^SRO(136,SRTN,3,$P(SRSEL(SRDA),U),0)),"^") I SROLD'=X D SADXO^SROCDX2 K DA
"RTN","SROCD0",82,0)
OASS S SRPOTH=$P(SRSEL(SRDA),U) D COTHADX^SROCDX
"RTN","SROCD0",83,0)
 Q
"RTN","SROCD0",84,0)
DUP K DIR S DIR("A",1)="",DIR("A",2)="This code has already been selected. Please try again.",DIR("A",3)="",DIR("A")="Press the ENTER key to continue",DIR(0)="FO" D ^DIR K DIR
"RTN","SROCD0",85,0)
 Q
"RTN","SROCD0",86,0)
DOTH W !,"Other Postop Diagnosis:",!
"RTN","SROCD0",87,0)
 N CNT,SRDUP,SRI,SRJ,SRNEW,SRSYS,SRSYS1,SRX,SCEC,ENVARR,SRNUM S SCEC=$$SCEC()
"RTN","SROCD0",88,0)
 K SRSEL S CNT=1,OTH=0 F  S OTH=$O(^SRO(136,SRTN,4,OTH)) Q:'OTH!(SRSOUT)  D
"RTN","SROCD0",89,0)
 .S (SRX,X)=$P(^SRO(136,SRTN,4,OTH,0),U),SRDIAG="NOT ENTERED"
"RTN","SROCD0",90,0)
 .S SRSYS=$$ICDSTR^SROICD(SRTN)
"RTN","SROCD0",91,0)
 .I X S Y=$$ICD^SROICD(SRTN,X),SRNUM=$P(Y,U,2),SRDES=$P(Y,U,4),SRDIAG=SRNUM_"  "_SRDES
"RTN","SROCD0",92,0)
 .S SRSYS1=$P(SRSYS,")",1),SRSYS1=$P(SRSYS1,"(",2) ;AAS
"RTN","SROCD0",93,0)
 .W !,CNT_". "_SRSYS1_" Code: "_SRDIAG S SRSEL(CNT)=OTH_"^"_SRSYS1_" Code: "_SRDIAG_"^"_SRNUM_"^"_SRX ;AAS
"RTN","SROCD0",94,0)
 .D:SCEC OIND
"RTN","SROCD0",95,0)
 .S CNT=CNT+1 I 'SCEC W !
"RTN","SROCD0",96,0)
 W !,CNT_". Enter NEW Other Postop Diagnosis Code",! K DIR S DIR("A")="Enter selection",DIR(0)="NO^1:"_CNT D ^DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1 Q
"RTN","SROCD0",97,0)
 Q:'Y  S SRDA=Y W !! I SRDA<CNT D  G DH
"RTN","SROCD0",98,0)
 .D HDR^SROCD W !,"Other Postop Diagnosis:",!!,SRDA_". "_$P(SRSEL(SRDA),U,2) I SCEC S OTH=$P(SRSEL(SRDA),"^") D OIND
"RTN","SROCD0",99,0)
 .K DIR S DIR(0)="SO^1:Update Other Postop Diagnosis Code;2:Update Service Connected/Environmental Indicators only"
"RTN","SROCD0",100,0)
 .S DIR("A")="Enter selection (1 or 2)",DIR("B")=1 D ^DIR I $D(DTOUT)!$D(DUOUT)!'Y Q
"RTN","SROCD0",101,0)
 .S SRDXY=Y D:SRDXY=1 ODXEN D:SRDXY=2 OSCEI Q
"RTN","SROCD0",102,0)
 ; JAS - 6/20/13 - Patch 177 - modifications to correct ^DIR incompatibility with ICD-10 Code Set Versioning Utility
"RTN","SROCD0",103,0)
 N X,Y,SRPRMT,SRDEF S SRPRMT="Enter new OTHER POSTOP DIAGNOSIS Code ",SRDEF=""
"RTN","SROCD0",104,0)
 D ICDSRCH^SROICD
"RTN","SROCD0",105,0)
 I $G(X)="^" K X G DH
"RTN","SROCD0",106,0)
 S SRNEW=+$G(Y) I $G(Y)="" G DH
"RTN","SROCD0",107,0)
 ; END 177
"RTN","SROCD0",108,0)
 S (SRDUP,SRI)=0 F  S SRI=$O(SRADIAG(SRI)) Q:'SRI  I SRADIAG(SRI)=SRNEW S SRDUP=1 Q
"RTN","SROCD0",109,0)
 I SRDUP D DUP G DH
"RTN","SROCD0",110,0)
 S:'$D(DA(1)) DA(1)=SRTN
"RTN","SROCD0",111,0)
 K DD,DO S DIC="^SRO(136,SRTN,4,",X=SRNEW,DIC(0)="L" D FILE^DICN K DA,DD,DIC,DO,DR
"RTN","SROCD0",112,0)
 D REMIND
"RTN","SROCD0",113,0)
DH D PASSDIAG^SROCDX1,ASSDIAG^SROCDX1,HDR^SROCD,DOTH
"RTN","SROCD0",114,0)
 Q
"RTN","SROCD0",115,0)
ODXEN ;
"RTN","SROCD0",116,0)
 ; JAS - 6/20/13 - Patch 177 - modifications to correct ^DIR incompatibility with ICD-10 Code Set Versioning Utility
"RTN","SROCD0",117,0)
 N X,Y,SRPRMT,SRDEF S SRPRMT="Enter new OTHER POSTOP DIAGNOSIS Code "
"RTN","SROCD0",118,0)
 S SROLD=$P(SRSEL(SRDA),U,4),SRDEF=$P($G(SRSEL(SRDA)),"^",3)
"RTN","SROCD0",119,0)
 D ICDSRCH^SROICD
"RTN","SROCD0",120,0)
 I $G(X)="^" K X Q
"RTN","SROCD0",121,0)
 S SRNEW=+$G(Y)
"RTN","SROCD0",122,0)
 ; END 177
"RTN","SROCD0",123,0)
 I X="@" S SRSOUT=0 D  I SRSOUT S SRSOUT=0 Q
"RTN","SROCD0",124,0)
 .K DIR S DIR("A")="SURE YOU WANT TO DELETE THE ENTIRE OTHER POSTOP DIAGNOSIS CODE",DIR(0)="YO",DIR("B")="NO"
"RTN","SROCD0",125,0)
 .D ^DIR K DIR I $D(DTOUT)!$D(DUOUT)!'Y S SRSOUT=1 Q
"RTN","SROCD0",126,0)
 .K DA,DIE,DR S DA=$P(SRSEL(SRDA),U),DA(1)=SRTN,DIE="^SRO(136,SRTN,4,",DR=".01///@" D ^DIE
"RTN","SROCD0",127,0)
 .S X=$P(SRSEL(SRDA),U,4) D DELASOC^SROCDX2 K DA,DIE,DR,SRSEL(SRDA)
"RTN","SROCD0",128,0)
 .D REMIND S SRSOUT=1
"RTN","SROCD0",129,0)
 S (SRDUP,SRI)=0 F  S SRI=$O(SRADIAG(SRI)) Q:'SRI  I SRADIAG(SRI)=SRNEW,SROLD'=SRNEW S SRDUP=1 Q
"RTN","SROCD0",130,0)
 I SRDUP D DUP Q
"RTN","SROCD0",131,0)
 I SRNEW=SROLD Q
"RTN","SROCD0",132,0)
 I SRNEW,SRNEW'=SROLD K DA,DIE,DIR S DA=$P(SRSEL(SRDA),U),DA(1)=SRTN,DIE="^SRO(136,SRTN,4,",DR=".01////"_SRNEW D ^DIE
"RTN","SROCD0",133,0)
 S X=$P(SRSEL(SRDA),U,4) D DELASOC^SROCDX2 K DA,DIE,DR
"RTN","SROCD0",134,0)
 D REMIND
"RTN","SROCD0",135,0)
OSCEI I '$D(SRCL) W !!,"  >>>  No SC/EI information required for this patient.  <<<" D PRESS Q
"RTN","SROCD0",136,0)
 D OSCEI^SROCD
"RTN","SROCD0",137,0)
 Q
"RTN","SROCD0",138,0)
SCEC() N SRSDATE,DFN,SCEC S SRSDATE=$S($D(SRTN):$P(^SRF(SRTN,0),U,9),1:DT)
"RTN","SROCD0",139,0)
 S DFN=$P(^SRF(SRTN,0),U) D CL^SDCO21(DFN,SRSDATE,,.SRCL)
"RTN","SROCD0",140,0)
 N CLV D SVC^VADPT S CLV=$G(VASV(15)) I CLV,('$G(SRCL(9))) S SRCL(9)=""   ; set CLV array if SD patch is not released yet and veteran is CLV eligible SR*3*183
"RTN","SROCD0",141,0)
 S SCEC=$S($D(SRCL):1,1:0)
"RTN","SROCD0",142,0)
 Q SCEC
"RTN","SROCD0",143,0)
ADCHK() ; check for other procedures with no associated diagnosis
"RTN","SROCD0",144,0)
 N SRADX,SROTH,SRQ S (SRADX,SROTH,SRQ)=0
"RTN","SROCD0",145,0)
 F  S SROTH=$O(^SRO(136,SRTN,3,SROTH)) Q:'SROTH  I '$O(^SRO(136,SRTN,3,SROTH,2,0)) S SRADX=1 Q
"RTN","SROCD0",146,0)
 Q SRADX
"RTN","SROCD0",147,0)
REMIND ; display reminder to update procedure/diagnosis associations
"RTN","SROCD0",148,0)
 K DIR W ! S DIR("A",1)="Please review and update procedure associations for this diagnosis."
"RTN","SROCD0",149,0)
 S DIR("A",2)="",DIR("A")="Press Enter/Return key to continue ",DIR(0)="FOA" D ^DIR K DIR
"RTN","SROCD0",150,0)
 Q
"RTN","SROCD0",151,0)
OIND D GETS^DIQ(136.04,OTH_","_SRTN_",",".02:.1","E","ENVARR")
"RTN","SROCD0",152,0)
 I $D(ENVARR(136.04,OTH_","_SRTN_",",.02,"E")) D
"RTN","SROCD0",153,0)
 .N SRCOLSPN S SRCOLSPN=13 W !
"RTN","SROCD0",154,0)
 .I $D(SRCL(3)) W ?SRCOLSPN,"SC:",$E(ENVARR(136.04,OTH_","_SRTN_",",.02,"E")) S SRCOLSPN=SRCOLSPN+8
"RTN","SROCD0",155,0)
 .I $D(SRCL(7)) W ?SRCOLSPN,"CV:",$E(ENVARR(136.04,OTH_","_SRTN_",",.08,"E")) S SRCOLSPN=SRCOLSPN+8
"RTN","SROCD0",156,0)
 .I $D(SRCL(1)) W ?SRCOLSPN,"AO:",$E(ENVARR(136.04,OTH_","_SRTN_",",.03,"E")) S SRCOLSPN=SRCOLSPN+8
"RTN","SROCD0",157,0)
 .I $D(SRCL(2)) W ?SRCOLSPN,"IR:",$E(ENVARR(136.04,OTH_","_SRTN_",",.04,"E")) S SRCOLSPN=SRCOLSPN+8
"RTN","SROCD0",158,0)
 .I $D(SRCL(4)) W ?SRCOLSPN,"SWAC:",$E(ENVARR(136.04,OTH_","_SRTN_",",.07,"E")) S SRCOLSPN=SRCOLSPN+8
"RTN","SROCD0",159,0)
 .I $D(SRCL(8)) W ?SRCOLSPN,"SHAD:",$E(ENVARR(136.04,OTH_","_SRTN_",",.09,"E")) S SRCOLSPN=SRCOLSPN+8
"RTN","SROCD0",160,0)
 .I $D(SRCL(5)) W ?SRCOLSPN,"MST:",$E(ENVARR(136.04,OTH_","_SRTN_",",.05,"E")) S SRCOLSPN=SRCOLSPN+8
"RTN","SROCD0",161,0)
 .I $D(SRCL(6)) W ?SRCOLSPN,"H&N:",$E(ENVARR(136.04,OTH_","_SRTN_",",.06,"E")) S SRCOLSPN=SRCOLSPN+8
"RTN","SROCD0",162,0)
 .I $D(SRCL(9)) W ?SRCOLSPN,"CLV:" D  S SRCOLSPN=SRCOLSPN+8       ;pwc Camp Lejeune SR*3*183
"RTN","SROCD0",163,0)
 .. ; display from file 136.04 if available, otherwise lookup answer from surgery file SR*3*183
"RTN","SROCD0",164,0)
 .. W:$E(ENVARR(136.04,OTH_","_SRTN_",",.1,"E"))'="" $E(ENVARR(136.04,OTH_","_SRTN_",",.1,"E"))
"RTN","SROCD0",165,0)
 .. I $E(ENVARR(136.04,OTH_","_SRTN_",",.1,"E"))="" N SRCLVD S SRCLVD=$$GET1^DIQ(130,$P(SR(0),"^",1)_",",.027,"","SRERR") W $E(SRCLVD,1) D
"RTN","SROCD0",166,0)
 ...; file SRCLVD variable back into file 136.04
"RTN","SROCD0",167,0)
 ...N SRFDA,SRMSG S SRFDA(136.04,OTH_","_SRTN_",",.1)=$S(SRCLVD="YES":1,1:0) D FILE^DIE("E","SRFDA","SRMSG")
"RTN","SROCD0",168,0)
 Q
"RTN","SROCD1")
0^12^B24301934^B22252247
"RTN","SROCD1",1,0)
SROCD1 ;BIR/ADM - CREATE CODING RECORD ;05/16/05
"RTN","SROCD1",2,0)
 ;;3.0;Surgery;**142,152,183**;24 Jun 93;Build 14
"RTN","SROCD1",3,0)
 ;
"RTN","SROCD1",4,0)
 N SR,SRD,SRDX,SRDICN,SRIEN,SRM,SRMOD,SRN,SRO,SROTH,SRP,SRPD,SRX,SRY,X,Y
"RTN","SROCD1",5,0)
 I $P($G(^SRO(136,SRTN,0)),"^")'=SRTN D NEW
"RTN","SROCD1",6,0)
 S SR(0)=$G(^SRF(SRTN,0))
"RTN","SROCD1",7,0)
 S $P(^SRO(136,SRTN,0),"^",2)=$P($G(^SRF(SRTN,"OP")),"^",2)
"RTN","SROCD1",8,0)
 S $P(^SRO(136,SRTN,0),"^",3)=$P($G(^SRF(SRTN,34)),"^",2)
"RTN","SROCD1",9,0)
SC S $P(^SRO(136,SRTN,0),"^",4)=$P(SR(0),"^",16)
"RTN","SROCD1",10,0)
AO S $P(^SRO(136,SRTN,0),"^",5)=$P(SR(0),"^",17)
"RTN","SROCD1",11,0)
IR S $P(^SRO(136,SRTN,0),"^",6)=$P(SR(0),"^",18)
"RTN","SROCD1",12,0)
EC S $P(^SRO(136,SRTN,0),"^",7)=$P(SR(0),"^",19)
"RTN","SROCD1",13,0)
MST S $P(^SRO(136,SRTN,0),"^",8)=$P(SR(0),"^",22)
"RTN","SROCD1",14,0)
HNC S $P(^SRO(136,SRTN,0),"^",9)=$P(SR(0),"^",23)
"RTN","SROCD1",15,0)
CV S $P(^SRO(136,SRTN,0),"^",10)=$P(SR(0),"^",24)
"RTN","SROCD1",16,0)
PRJ S $P(^SRO(136,SRTN,0),"^",11)=$P(SR(0),"^",25)
"RTN","SROCD1",17,0)
CLV S $P(^SRC(136,SRTN,0),"^",12)=$P(SR(0),"^",27)   ;PWC SR*3*183 Camp Lejeune
"RTN","SROCD1",18,0)
PMOD ;
"RTN","SROCD1",19,0)
 S SRM=0 F  S SRM=$O(^SRF(SRTN,"OPMOD",SRM)) Q:'SRM  D
"RTN","SROCD1",20,0)
 .S SRMOD=$P(^SRF(SRTN,"OPMOD",SRM,0),"^")
"RTN","SROCD1",21,0)
 .S SRY(136.01,"+1,"_SRTN_",",.01)=SRMOD D UPDATE^DIE("","SRY") K SRY
"RTN","SROCD1",22,0)
PDX ;
"RTN","SROCD1",23,0)
 S SRD=0 F  S SRD=$O(^SRF(SRTN,"PADX",SRD)) Q:'SRD  D
"RTN","SROCD1",24,0)
 .S SRX=$P(^SRF(SRTN,"PADX",SRD,0),"^")
"RTN","SROCD1",25,0)
 .I SRX=0 S SRDX=$P($G(^SRF(SRTN,34)),"^",2)
"RTN","SROCD1",26,0)
 .E  S SRDX=$P($G(^SRF(SRTN,15,SRX,0)),"^",3)
"RTN","SROCD1",27,0)
 .I SRDX S SRY(136.02,"+1,"_SRTN_",",.01)=SRDX D UPDATE^DIE("","SRY") K SRY
"RTN","SROCD1",28,0)
POTH ;
"RTN","SROCD1",29,0)
 S SRO=0 F  S SRO=$O(^SRF(SRTN,13,SRO)) Q:'SRO  D
"RTN","SROCD1",30,0)
 .S SROTH=$P($G(^SRF(SRTN,13,SRO,2)),"^") Q:'SROTH  S SRDICN=1
"RTN","SROCD1",31,0)
 .K DD,DO,DIC S DIC="^SRO(136,SRTN,3,",DIC(0)="L",X=SROTH D FILE^DICN K DA,DD,DIC,DO,DR S SRIEN=+Y I SRIEN'>0 Q
"RTN","SROCD1",32,0)
 .S SRM=0 F  S SRM=$O(^SRF(SRTN,13,SRO,"MOD",SRM)) Q:'SRM  D
"RTN","SROCD1",33,0)
 ..S SRMOD=$P(^SRF(SRTN,13,SRO,"MOD",SRM,0),"^")
"RTN","SROCD1",34,0)
 ..S SRY(136.31,"+1,"_SRIEN_","_SRTN_",",.01)=SRMOD D UPDATE^DIE("","SRY") K SRY
"RTN","SROCD1",35,0)
 .S SRD=0 F  S SRD=$O(^SRF(SRTN,13,SRO,"OADX",SRD)) Q:'SRD  D
"RTN","SROCD1",36,0)
 ..S SRX=$P(^SRF(SRTN,13,SRO,"OADX",SRD,0),"^")
"RTN","SROCD1",37,0)
 ..I SRX=0 S SRDX=$P($G(^SRF(SRTN,34)),"^",2)
"RTN","SROCD1",38,0)
 ..E  S SRDX=$P($G(^SRF(SRTN,15,SRX,0)),"^",3)
"RTN","SROCD1",39,0)
 ..I SRDX S SRY(136.32,"+1,"_SRIEN_","_SRTN_",",.01)=SRDX D UPDATE^DIE("","SRY") K SRY
"RTN","SROCD1",40,0)
 ; other diagnoses and environmental indicators
"RTN","SROCD1",41,0)
 S SRP=0 F  S SRP=$O(^SRF(SRTN,15,SRP)) Q:'SRP  D
"RTN","SROCD1",42,0)
 .S SRPD=$P(^SRF(SRTN,15,SRP,0),"^",3) Q:'SRPD  S SRIS=$G(^SRF(SRTN,15,SRP,2))
"RTN","SROCD1",43,0)
 .S SRY(136.04,"+1,"_SRTN_",",.01)=SRPD,SRY(136.04,"+1,"_SRTN_",",.02)=$P(SRIS,"^")
"RTN","SROCD1",44,0)
 .S SRY(136.04,"+1,"_SRTN_",",.03)=$P(SRIS,"^",2),SRY(136.04,"+1,"_SRTN_",",.04)=$P(SRIS,"^",3)
"RTN","SROCD1",45,0)
 .S SRY(136.04,"+1,"_SRTN_",",.05)=$P(SRIS,"^",4),SRY(136.04,"+1,"_SRTN_",",.06)=$P(SRIS,"^",5)
"RTN","SROCD1",46,0)
 .S SRY(136.04,"+1,"_SRTN_",",.07)=$P(SRIS,"^",6),SRY(136.04,"+1,"_SRTN_",",.08)=$P(SRIS,"^",7)
"RTN","SROCD1",47,0)
 .S SRY(136.04,"+1,"_SRTN_",",.09)=$P(SRIS,"^",8),SRY(136.04,"+1,"_SRTN_",",.1)=$P(SRIS,"^",9)  ;pwc SR*3*183 Camp Lejeune
"RTN","SROCD1",48,0)
 .D UPDATE^DIE("","SRY") K SRIS,SRY
"RTN","SROCD1",49,0)
 Q
"RTN","SROCD1",50,0)
NEW K DA,DIC,DD,DO,DINUM S (DINUM,X)=SRTN,DIC="^SRO(136,",DIC(0)="L" D FILE^DICN K DD,DO,DIC,DINUM
"RTN","SROCD1",51,0)
 Q
"RTN","SROCD1",52,0)
CHNG() ; check for changes to data
"RTN","SROCD1",53,0)
 N SRI,SRJ,SRK,SRS,SRCHNG S SRCHNG=0
"RTN","SROCD1",54,0)
 M ^TMP("SRED2",$J,SRTN)=^SRO(136,SRTN)
"RTN","SROCD1",55,0)
 I $G(^TMP("SRED1",$J,SRTN,0))'=$G(^TMP("SRED2",$J,SRTN,0)) Q 1
"RTN","SROCD1",56,0)
 D COMP
"RTN","SROCD1",57,0)
 Q SRCHNG
"RTN","SROCD1",58,0)
COMP ;
"RTN","SROCD1",59,0)
 S SRI=0 F  S SRI=$O(^TMP("SRED1",$J,SRTN,1,SRI)) Q:'SRI!SRCHNG  I $G(^TMP("SRED1",$J,SRTN,1,SRI,0))'=$G(^TMP("SRED2",$J,SRTN,1,SRI,0)) S SRCHNG=1 Q
"RTN","SROCD1",60,0)
 S SRI=0 F  S SRI=$O(^TMP("SRED1",$J,SRTN,2,SRI)) Q:'SRI!SRCHNG  I $G(^TMP("SRED1",$J,SRTN,2,SRI,0))'=$G(^TMP("SRED2",$J,SRTN,2,SRI,0)) S SRCHNG=1 Q
"RTN","SROCD1",61,0)
 S SRI=0 F  S SRI=$O(^TMP("SRED1",$J,SRTN,3,SRI)) Q:'SRI!SRCHNG  D  Q:SRCHNG
"RTN","SROCD1",62,0)
 .I $G(^TMP("SRED1",$J,SRTN,3,SRI,0))'=$G(^TMP("SRED2",$J,SRTN,3,SRI,0)) S SRCHNG=1 Q
"RTN","SROCD1",63,0)
 .F SRS=1,2 S SRK=0 F  S SRK=$O(^TMP("SRED1",$J,SRTN,3,SRI,SRS,SRK)) Q:'SRK!SRCHNG  I $G(^TMP("SRED1",$J,SRTN,3,SRI,SRS,SRK,0))'=$G(^TMP("SRED2",$J,SRTN,3,SRI,SRS,SRK,0)) S SRCHNG=1 Q
"RTN","SROCD1",64,0)
 S SRI=0 F  S SRI=$O(^TMP("SRED1",$J,SRTN,4,SRI)) Q:'SRI!SRCHNG  I $G(^TMP("SRED1",$J,SRTN,4,SRI,0))'=$G(^TMP("SRED2",$J,SRTN,4,SRI,0)) S SRCHNG=1 Q
"RTN","SROCD1",65,0)
 S SRI=0 F  S SRI=$O(^TMP("SRED2",$J,SRTN,1,SRI)) Q:'SRI!SRCHNG  I $G(^TMP("SRED2",$J,SRTN,1,SRI,0))'=$G(^TMP("SRED1",$J,SRTN,1,SRI,0)) S SRCHNG=1 Q
"RTN","SROCD1",66,0)
 S SRI=0 F  S SRI=$O(^TMP("SRED2",$J,SRTN,2,SRI)) Q:'SRI!SRCHNG  I $G(^TMP("SRED2",$J,SRTN,2,SRI,0))'=$G(^TMP("SRED1",$J,SRTN,2,SRI,0)) S SRCHNG=1 Q
"RTN","SROCD1",67,0)
 S SRI=0 F  S SRI=$O(^TMP("SRED2",$J,SRTN,3,SRI)) Q:'SRI!SRCHNG  D  Q:SRCHNG
"RTN","SROCD1",68,0)
 .I $G(^TMP("SRED2",$J,SRTN,3,SRI,0))'=$G(^TMP("SRED1",$J,SRTN,3,SRI,0)) S SRCHNG=1 Q
"RTN","SROCD1",69,0)
 .F SRS=1,2 S SRK=0 F  S SRK=$O(^TMP("SRED2",$J,SRTN,3,SRI,SRS,SRK)) Q:'SRK!SRCHNG  I $G(^TMP("SRED2",$J,SRTN,3,SRI,SRS,SRK,0))'=$G(^TMP("SRED1",$J,SRTN,3,SRI,SRS,SRK,0)) S SRCHNG=1 Q
"RTN","SROCD1",70,0)
 S SRI=0 F  S SRI=$O(^TMP("SRED2",$J,SRTN,4,SRI)) Q:'SRI!SRCHNG  I $G(^TMP("SRED2",$J,SRTN,4,SRI,0))'=$G(^TMP("SRED1",$J,SRTN,4,SRI,0)) S SRCHNG=1 Q
"RTN","SROCD1",71,0)
 K ^TMP("SRED1",$J),^TMP("SRED2",$J)
"RTN","SROCD1",72,0)
 Q
"RTN","SROCD3")
0^4^B32220178^B25974520
"RTN","SROCD3",1,0)
SROCD3 ;BIR/ADM - ASK SC/EI QUESTIONS FOR CODING ;15 Nov 2018  12:07 PM
"RTN","SROCD3",2,0)
 ;;3.0;Surgery;**142,152,159,183**;24 Jun 93;Build 14
"RTN","SROCD3",3,0)
 ;
"RTN","SROCD3",4,0)
 ; Reference to DIS^DGRPDB supported by DBIA #700
"RTN","SROCD3",5,0)
 ; Reference to Field #.322013 in File #2 supported by DBIA #3475
"RTN","SROCD3",6,0)
 ;
"RTN","SROCD3",7,0)
ASK W ! K DIR S DIR("A")="Do you want to update classification information (Y/N)? ",DIR("B")="NO",DIR(0)="YA" D ^DIR K DIR I 'Y!$D(DTOUT)!$D(DUOUT) Q
"RTN","SROCD3",8,0)
SCEI ; output of SC/EI conditions
"RTN","SROCD3",9,0)
 N SRAO,SRCV,SRDR,SREC,SRELIG,SRHNC,SRIR,SRMST,SRPERC,SRQ,SREEQ,SRSC,SRPRJ,VADM,VAEL,VASV,SRY,SRCLV
"RTN","SROCD3",10,0)
 D DEM^VADPT,ELIG^VADPT,SVC^VADPT
"RTN","SROCD3",11,0)
 S SRELIG=$P(VAEL(1),"^",2),SRSC=$P(VAEL(3),"^"),SRSC=$S(SRSC:"YES",SRSC=0:"NO",1:""),SRPERC=$P(VAEL(3),"^",2)
"RTN","SROCD3",12,0)
 S SRAO=$S(VASV(2):"YES",1:"NO"),SRIR=$S(VASV(3):"YES",1:"NO"),SRCV=$S(VASV(10):"YES",1:"NO"),SRPRJ=$S($G(VASV(11)):"YES",1:"NO")
"RTN","SROCD3",13,0)
 S SRMST=$S($D(SRCL(5)):"YES",1:"NO"),SRHNC=$S($D(SRCL(6)):"YES",1:"NO"),SRCLV=$S($D(SRCL(9)):"YES",1:"NO")
"RTN","SROCD3",14,0)
 S DIC=2,DA=DFN,DR=".322013",DIQ="SRY",DIQ(0)="I" D EN^DIQ1 K DA,DIC,DIQ,DR
"RTN","SROCD3",15,0)
 S SREC=SRY(2,DFN,.322013,"I"),SREC=$S(SREC="Y":"YES",1:"NO")
"RTN","SROCD3",16,0)
 W @IOF,!,VADM(1)_"  ("_VA("PID")_")       ",$P(VAEL(6),"^",2),!!,"   * * * Eligibility Information and Service Connected Conditions * * *"
"RTN","SROCD3",17,0)
 W !!,?5,"Primary Eligibility: "_SRELIG,!,?5,"Combat Vet: "_SRCV,?22,"A/O Exp.: "_SRAO,?39,"M/S Trauma: "_SRMST
"RTN","SROCD3",18,0)
 W !,?5,"ION Rad.: "_SRIR,?22,"SWAC: "_SREC,?39,"H/N Cancer: "_SRHNC
"RTN","SROCD3",19,0)
 W !,?5,"PROJ 112/SHAD: "_SRPRJ,?39,"Camp Lejeune: "_SRCLV    ;pwc SR*3*183 Camp Lejeune
"RTN","SROCD3",20,0)
 D DIS^DGRPDB
"RTN","SROCD3",21,0)
 W ! F I=1:1:79 W "-"
"RTN","SROCD3",22,0)
SUP S SRY="operation" I $D(SRTN),$P($G(^SRF(SRTN,"NON")),"^")="Y" S SRY="procedure"
"RTN","SROCD3",23,0)
 K DIR W !!,"Please supply the following required information about this "_SRY_":",! S:$D(SRTN) DA=SRTN S SRDR="" S:'$D(SRQ) SRQ=0 D  I SRQ G END
"RTN","SROCD3",24,0)
 .I $D(SRCL(3)) D SC I SRQ Q
"RTN","SROCD3",25,0)
 .I $D(SRCL(7)) D CV I SRQ Q
"RTN","SROCD3",26,0)
 .I $D(SRCL(1)) D AO I SRQ Q
"RTN","SROCD3",27,0)
 .I $D(SRCL(2)) D IR I SRQ Q
"RTN","SROCD3",28,0)
 .I $D(SRCL(4)) D EC I SRQ Q
"RTN","SROCD3",29,0)
 .I $D(SRCL(8)) D PRJ I SRQ Q
"RTN","SROCD3",30,0)
 .I $D(SRCL(5)) D MST I SRQ Q
"RTN","SROCD3",31,0)
 .I $D(SRCL(6)) D HNC I SRQ Q
"RTN","SROCD3",32,0)
 .I $D(SRCL(9)) D CLV   ;pwc Camp Lejeune SR*3*183
"RTN","SROCD3",33,0)
 K DA,DIE,DR S:$D(SRTN) DA=SRTN,DIE=136,DR=SRDR D ^DIE
"RTN","SROCD3",34,0)
UPDX I $O(^SRO(136,SRTN,4,0)) D
"RTN","SROCD3",35,0)
 .W ! K DIR S DIR("A",1)="Update all 'OTHER POSTOP DIAGNOSIS' Eligibility and Service Connected",DIR("A")="Conditions with these values (Y/N)"
"RTN","SROCD3",36,0)
 .S DIR("B")="NO",DIR(0)="Y" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) Q
"RTN","SROCD3",37,0)
 .I Y D UPDSC
"RTN","SROCD3",38,0)
END K DA,DIE,DR,SRZ,X,Y
"RTN","SROCD3",39,0)
 Q
"RTN","SROCD3",40,0)
SC S DIR("A")="Treatment related to Service Connected condition (Y/N)",DIR(0)="136,.04" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRQ=1 Q
"RTN","SROCD3",41,0)
 I X=""!(X="@") W !,$C(7),?15,"Enter YES or NO." G SC
"RTN","SROCD3",42,0)
 S SRCL(3)=Y,SRDR=$G(SRDR)_".04////"_SRCL(3)_";"
"RTN","SROCD3",43,0)
 S SRCL(3,"UPDATE")=1
"RTN","SROCD3",44,0)
 Q
"RTN","SROCD3",45,0)
CV N SRCVD S SRCVD=$P(^SRO(136,DA,0),"^",10),DIR("B")=$S(SRCVD=0:"NO",1:"YES")
"RTN","SROCD3",46,0)
 S DIR("A")="Treatment related to Combat (Y/N)",DIR(0)="136,.1" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRQ=1 Q
"RTN","SROCD3",47,0)
 I X=""!(X="@") W !,$C(7),?15,"Enter YES or NO." G CV
"RTN","SROCD3",48,0)
 S SRCL(7)=Y,SRDR=SRDR_".1////"_SRCL(7)_";"
"RTN","SROCD3",49,0)
 S SRCL(7,"UPDATE")=1
"RTN","SROCD3",50,0)
 Q
"RTN","SROCD3",51,0)
AO S DIR("A")="Treatment related to Agent Orange Exposure (Y/N)",DIR(0)="136,.05" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRQ=1 Q
"RTN","SROCD3",52,0)
 I X=""!(X="@") W !,$C(7),?15,"Enter YES or NO." G AO
"RTN","SROCD3",53,0)
 S SRCL(1)=Y,SRDR=SRDR_".05////"_SRCL(1)_";"
"RTN","SROCD3",54,0)
 S SRCL(1,"UPDATE")=1
"RTN","SROCD3",55,0)
 Q
"RTN","SROCD3",56,0)
IR S DIR("A")="Treatment related to Ionizing Radiation Exposure (Y/N)",DIR(0)="136,.06" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRQ=1 Q
"RTN","SROCD3",57,0)
 I X=""!(X="@") W !,$C(7),?15,"Enter YES or NO." G IR
"RTN","SROCD3",58,0)
 S SRCL(2)=Y,SRDR=SRDR_".06////"_SRCL(2)_";"
"RTN","SROCD3",59,0)
 S SRCL(2,"UPDATE")=1
"RTN","SROCD3",60,0)
 Q
"RTN","SROCD3",61,0)
EC S DIR("A")="Treatment related to SW Asia (Y/N)",DIR(0)="136,.07" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRQ=1 Q
"RTN","SROCD3",62,0)
 I X=""!(X="@") W !,$C(7),?15,"Enter YES or NO." G EC
"RTN","SROCD3",63,0)
 S SRCL(4)=Y,SRDR=SRDR_".07////"_SRCL(4)_";"
"RTN","SROCD3",64,0)
 S SRCL(4,"UPDATE")=1
"RTN","SROCD3",65,0)
 Q
"RTN","SROCD3",66,0)
PRJ S DIR("A")="Treatment related to PROJ 112/SHAD (Y/N)",DIR(0)="136,.11" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRQ=1 Q
"RTN","SROCD3",67,0)
 I X=""!(X="@") W !,$C(7),?15,"Enter YES or NO." G PRJ
"RTN","SROCD3",68,0)
 S SRCL(8)=Y,SRDR=SRDR_".11////"_SRCL(8)_";"
"RTN","SROCD3",69,0)
 S SRCL(8,"UPDATE")=1
"RTN","SROCD3",70,0)
 Q
"RTN","SROCD3",71,0)
MST S DIR("A")="Treatment related to Military Sexual Trauma (Y/N)",DIR(0)="136,.08" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRQ=1 Q
"RTN","SROCD3",72,0)
 I X=""!(X="@") W !,$C(7),?15,"Enter YES or NO." G MST
"RTN","SROCD3",73,0)
 S SRCL(5)=Y,SRDR=SRDR_".08////"_SRCL(5)_";"
"RTN","SROCD3",74,0)
 S SRCL(5,"UPDATE")=1
"RTN","SROCD3",75,0)
 Q
"RTN","SROCD3",76,0)
HNC S DIR("A")="Treatment related to Head and/or Neck Cancer (Y/N)",DIR(0)="136,.09" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRQ=1 Q
"RTN","SROCD3",77,0)
 I X=""!(X="@") W !,$C(7),?15,"Enter YES or NO." G HNC
"RTN","SROCD3",78,0)
 S SRCL(6)=Y,SRDR=SRDR_".09////"_SRCL(6)_";"
"RTN","SROCD3",79,0)
 S SRCL(6,"UPDATE")=1
"RTN","SROCD3",80,0)
 Q
"RTN","SROCD3",81,0)
CLV ; pwc Camp Lejeune SR*3*183 
"RTN","SROCD3",82,0)
 N SRERR S SRCL(9)=$$GET1^DIQ(136,DA_",",.12,"","SRERR")
"RTN","SROCD3",83,0)
 I SRCL(9)="" S SRCL(9)=$$GET1^DIQ(130,$P(SR(0),"^",1)_",",.027,"","SRERR")  ;get default from Surgery file if not in Post-Op diag file
"RTN","SROCD3",84,0)
 S DIR("A")="Treatment related to Camp Lejeune (Y/N)",DIR("B")=$S($G(SRCL(9))'="":SRCL(9),1:""),DIR(0)="136,.12" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRQ=1 Q
"RTN","SROCD3",85,0)
 I X=""!(X="@") W !,$C(7),?15,"Enter YES or NO." G CLV
"RTN","SROCD3",86,0)
 S SRCL(9)=Y,SRDR=SRDR_".12////"_SRCL(9)_";"
"RTN","SROCD3",87,0)
 S SRCL(9,"UPDATE")=1
"RTN","SROCD3",88,0)
 Q
"RTN","SROCD3",89,0)
PRESS W ! K DIR S DIR("A")="Press RETURN to continue  ",DIR(0)="FOA" D ^DIR K DIR W @IOF
"RTN","SROCD3",90,0)
 Q
"RTN","SROCD3",91,0)
UPDSC ;Update existing DX to Service Connected/Environmental Indicators associations.
"RTN","SROCD3",92,0)
 K DA,DIE,DR
"RTN","SROCD3",93,0)
 S (DA,I)=0,DA(1)=SRTN,DIE="^SRO(136,"_SRTN_",4,"
"RTN","SROCD3",94,0)
 D:$D(SRCL(1,"UPDATE")) BLDDR(.03,SRCL(1))
"RTN","SROCD3",95,0)
 D:$D(SRCL(2,"UPDATE")) BLDDR(.04,SRCL(2))
"RTN","SROCD3",96,0)
 D:$D(SRCL(3,"UPDATE")) BLDDR(.02,SRCL(3))
"RTN","SROCD3",97,0)
 D:$D(SRCL(4,"UPDATE")) BLDDR(.07,SRCL(4))
"RTN","SROCD3",98,0)
 D:$D(SRCL(5,"UPDATE")) BLDDR(.05,SRCL(5))
"RTN","SROCD3",99,0)
 D:$D(SRCL(6,"UPDATE")) BLDDR(.06,SRCL(6))
"RTN","SROCD3",100,0)
 D:$D(SRCL(7,"UPDATE")) BLDDR(.08,SRCL(7))
"RTN","SROCD3",101,0)
 D:$D(SRCL(8,"UPDATE")) BLDDR(.09,SRCL(8))
"RTN","SROCD3",102,0)
 D:$D(SRCL(9,"UPDATE")) BLDDR(.1,SRCL(9))   ;pwc Camp Lejeune SR*3*183
"RTN","SROCD3",103,0)
 F I=1:1 S DA=$O(^SRO(136,SRTN,4,DA)) Q:DA=""  D ^DIE
"RTN","SROCD3",104,0)
 Q
"RTN","SROCD3",105,0)
BLDDR(DXPIECE,NEWSC) ;Build the DR string for updating DX/Service Indicators associations
"RTN","SROCD3",106,0)
 S:$D(DR) DR=DR_";"
"RTN","SROCD3",107,0)
 S:'$D(DR) DR=""
"RTN","SROCD3",108,0)
 S DR=DR_DXPIECE_"///"_NEWSC
"RTN","SROCD3",109,0)
 K DXPIECE,NEWSC
"RTN","SROCD3",110,0)
 Q
"RTN","SROCD4")
0^5^B24773512^B20829958
"RTN","SROCD4",1,0)
SROCD4 ;BIR/ADM - MARK CASE CODING COMPLETE ;10/17/05
"RTN","SROCD4",2,0)
 ;;3.0;Surgery;**142,177,183**;24 Jun 93;Build 14
"RTN","SROCD4",3,0)
 ;
"RTN","SROCD4",4,0)
 ; Reference to CL^SDCO21 supported by DBIA #406
"RTN","SROCD4",5,0)
 ;
"RTN","SROCD4",6,0)
 N SR,SRCL,SRDATA,SRDX,SRK,SRMISS,SROTH,SRSDATE,SRTYPE
"RTN","SROCD4",7,0)
 S SR(0)=^SRO(136,SRTN,0) S SRSOUT=0,SREDIT=1
"RTN","SROCD4",8,0)
 I $P(SR(0),"^",2)="" S SRMISS("PRINCIPAL PROCEDURE CODE")=""
"RTN","SROCD4",9,0)
 I $P(SR(0),"^",3)="" S SRMISS("PRINCIPAL POSTOP DIAGNOSIS CODE")=""
"RTN","SROCD4",10,0)
 S DFN=$P(^SRF(SRTN,0),"^"),SRSDATE=$P(^SRF(SRTN,0),"^",9) D CL^SDCO21(DFN,SRSDATE,,.SRCL) I $D(SRCL) D
"RTN","SROCD4",11,0)
 . N CLV D SVC^VADPT S CLV=$G(VASV(15)) I CLV,('$G(SRCL(9))) S SRCL(9)=""  ;set CLV array if SD patch is not released yet and veteran is CLV eligible SR*3*183
"RTN","SROCD4",12,0)
 . D PSCEI
"RTN","SROCD4",13,0)
 I '$O(^SRO(136,SRTN,2,0)) S SRMISS("PRINCIPAL ASSOCIATED DIAGNOSIS")=""
"RTN","SROCD4",14,0)
 S SROTH=0 F  S SROTH=$O(^SRO(136,SRTN,3,SROTH)) Q:'SROTH  I '$O(^SRO(136,SRTN,3,SROTH,2,0)) S SRMISS("OTHER ASSOCIATED DIAGNOSIS")="" Q
"RTN","SROCD4",15,0)
 S SROTH=0 F  S SROTH=$O(^SRO(136,SRTN,4,SROTH)) Q:'SROTH  I $D(SRCL) S SRDX=^SRO(136,SRTN,4,SROTH,0) D OSCEI
"RTN","SROCD4",16,0)
 I $D(SRMISS) D MISS Q
"RTN","SROCD4",17,0)
 I $P($G(^SRO(136,SRTN,10)),"^"),'$$CHNG^SROCD1 D  Q
"RTN","SROCD4",18,0)
 .I '$P(^SRF(SRTN,0),"^",15) D FILE Q
"RTN","SROCD4",19,0)
 I '$P($G(^SRO(136,SRTN,10)),"^") D  D ^DIR K DIR I $D(DTOUT)!$D(DUOUT)!'Y Q
"RTN","SROCD4",20,0)
 .W ! K DIR S DIR("A")="Is the coding of this case complete and ready to send to PCE",DIR("B")="NO",DIR(0)="Y"
"RTN","SROCD4",21,0)
FILE D NOW^%DTC S SRNOW=$E(%,1,12) D
"RTN","SROCD4",22,0)
 .K DA,DIE,DR S DA=SRTN,DIE=136,DR="10////1" D ^DIE K DA,DIE,DR
"RTN","SROCD4",23,0)
 .K DD,DO S DIC="^SRO(136,SRTN,11,",DIC(0)="L",X=DUZ,DIC("DR")="1////"_SRNOW D FILE^DICN K DA,DD,DIC,DO,DR
"RTN","SROCD4",24,0)
 .W !!,"Processing data to be sent to PCE..." D CHKIN I SRK D  K SRK Q
"RTN","SROCD4",25,0)
 ..W !!,"Information needed to send the case to PCE is missing. Use the PCE"
"RTN","SROCD4",26,0)
 ..W !,"Filing Status Report to review missing information. The case will be"
"RTN","SROCD4",27,0)
 ..W !,"sent to PCE upon completion of the missing information.",! D PAGE
"RTN","SROCD4",28,0)
 .D START^SROPCEP ; send to PCE
"RTN","SROCD4",29,0)
 .W !!,"Coding completed and sent to PCE.",! D PAGE
"RTN","SROCD4",30,0)
 Q
"RTN","SROCD4",31,0)
CHKIN ; check for items in file 130 required by PCE
"RTN","SROCD4",32,0)
 N SR,SRAO,SRATT,SRCHK,SRCPT,SRCV,SRDATE,SRDEPC,SRDIAG,SRDXF,SREC,SRHNC,SRINOUT,SRIR,SRLOC,SRMST,SRNON,SRO,SRODIAG,SRPROV,SRRPROV,SRSC,SRUP,SRX
"RTN","SROCD4",33,0)
 D UTIL^SROPCEP
"RTN","SROCD4",34,0)
 Q
"RTN","SROCD4",35,0)
MISS W !!,"Coding of this surgical case is not complete.",!,"The following items are missing:",!
"RTN","SROCD4",36,0)
 S SRDATA="" F  S SRDATA=$O(SRMISS(SRDATA)) Q:SRDATA=""  W ?5,SRDATA,!
"RTN","SROCD4",37,0)
 W !,"This case cannot be sent to PCE until all missing information is supplied.",!
"RTN","SROCD4",38,0)
PAGE K DIR S DIR(0)="FOA",DIR("A")="Press Enter/Return key to continue " D ^DIR K DIR
"RTN","SROCD4",39,0)
 Q
"RTN","SROCD4",40,0)
PSCEI S SRTYPE="PRINCIPAL"
"RTN","SROCD4",41,0)
 I $D(SRCL(1)),$P(SR(0),"^",5)="" D SRSET Q
"RTN","SROCD4",42,0)
 I $D(SRCL(2)),$P(SR(0),"^",6)="" D SRSET Q
"RTN","SROCD4",43,0)
 I $D(SRCL(3)),$P(SR(0),"^",4)="" D SRSET Q
"RTN","SROCD4",44,0)
 I $D(SRCL(4)),$P(SR(0),"^",7)="" D SRSET Q
"RTN","SROCD4",45,0)
 I $D(SRCL(5)),$P(SR(0),"^",8)="" D SRSET Q
"RTN","SROCD4",46,0)
 I $D(SRCL(6)),$P(SR(0),"^",9)="" D SRSET Q
"RTN","SROCD4",47,0)
 I $D(SRCL(7)),$P(SR(0),"^",10)="" D SRSET Q
"RTN","SROCD4",48,0)
 I $D(SRCL(8)),$P(SR(0),"^",11)="" D SRSET Q  ;pwc added SHAD code that was missing
"RTN","SROCD4",49,0)
 I $D(SRCL(9)),$P(SR(0),"^",12)="" D SRSET    ;pwc Camp Lejeune SR*3*183
"RTN","SROCD4",50,0)
 Q
"RTN","SROCD4",51,0)
OSCEI S SRTYPE="OTHER DIAGNOSIS"
"RTN","SROCD4",52,0)
 I $D(SRCL(1)),$P(SRDX,"^",3)="" D SRSET Q
"RTN","SROCD4",53,0)
 I $D(SRCL(2)),$P(SRDX,"^",4)="" D SRSET Q
"RTN","SROCD4",54,0)
 I $D(SRCL(3)),$P(SRDX,"^",2)="" D SRSET Q
"RTN","SROCD4",55,0)
 I $D(SRCL(4)),$P(SRDX,"^",7)="" D SRSET Q
"RTN","SROCD4",56,0)
 I $D(SRCL(5)),$P(SRDX,"^",5)="" D SRSET Q
"RTN","SROCD4",57,0)
 I $D(SRCL(6)),$P(SRDX,"^",6)="" D SRSET Q
"RTN","SROCD4",58,0)
 I $D(SRCL(7)),$P(SRDX,"^",8)="" D SRSET Q
"RTN","SROCD4",59,0)
 I $D(SRCL(8)),$P(SRDX,"^",9)="" D SRSET Q  ;pwc added SHAD code that was missing
"RTN","SROCD4",60,0)
 I $D(SRCL(9)),$P(SRDX,"^",10)="" D SRSET   ;pwc Camp Lejeune SR*3*183
"RTN","SROCD4",61,0)
 Q
"RTN","SROCD4",62,0)
SRSET S SRMISS(SRTYPE_" SC/EI")=""
"RTN","SROCD4",63,0)
 Q
"RTN","SROCD4",64,0)
CONV ; convert coding data from file 130 to file 136
"RTN","SROCD4",65,0)
 I $O(^SRO(136,0)) D MES^XPDUTL("Conversion has already run.") Q
"RTN","SROCD4",66,0)
 D NITE^SROPCE
"RTN","SROCD4",67,0)
C2 N SRCT,SRD,SRODX,SRPDX,SRPP,SROP,SRP,SRTN
"RTN","SROCD4",68,0)
 D MES^XPDUTL(" Converting coding data from file 130 to file 136...")
"RTN","SROCD4",69,0)
 S (SRCT,SRTN)=0 F  S SRTN=$O(^SRF(SRTN)) Q:'SRTN  D
"RTN","SROCD4",70,0)
 .I '$P($G(^SRF(SRTN,.2)),"^",12)&'$P($G(^SRF(SRTN,"NON")),"^",5) Q
"RTN","SROCD4",71,0)
 .S SRPP=$P($G(^SRF(SRTN,"OP")),"^",2),(SROP,SRP)=0 F  S SRP=$O(^SRF(SRTN,13,SRP)) Q:'SRP  I $P($G(^SRF(SRTN,13,SRP,2)),"^") S SROP=1 Q
"RTN","SROCD4",72,0)
 .S SRPDX=$P($G(^SRF(SRTN,34)),"^",2),(SRODX,SRD)=0 F  S SRD=$O(^SRF(SRTN,15,SRD)) Q:'SRD  I $P($G(^SRF(SRTN,15,SRD,0)),"^",3) S SRODX=1 Q
"RTN","SROCD4",73,0)
 .I SRPP!SROP!SRPDX!SRODX D
"RTN","SROCD4",74,0)
 ..Q:$D(^SRO(136,SRTN,0))
"RTN","SROCD4",75,0)
 ..D ^SROCD1 S SRCT=SRCT+1 I '(SRCT#10000) D MES^XPDUTL(SRCT_" cases converted... ")
"RTN","SROCD4",76,0)
 D MES^XPDUTL("Total cases converted: "_SRCT)
"RTN","SROCD4",77,0)
 Q
"RTN","SROCD4",78,0)
PRE ; pre-install entry
"RTN","SROCD4",79,0)
 ; delete APCE x-refs
"RTN","SROCD4",80,0)
 K DIE,DR,DIK,DA S DIK="^DD(130.16,3,1,",DA=1,DA(1)=3,DA(2)=130.16 D ^DIK
"RTN","SROCD4",81,0)
 K DIK,DA S DIK="^DD(130.165,.01,1,",DA=2,DA(1)=.01,DA(2)=130.165 D ^DIK
"RTN","SROCD4",82,0)
 K DIK,DA S DIK="^DD(130.18,.01,1,",DA=9,DA(1)=.01,DA(2)=130.18 D ^DIK
"RTN","SROCD4",83,0)
 K DIK,DA S DIK="^DD(130.18,3,1,",DA=1,DA(1)=3,DA(2)=130.18 D ^DIK
"RTN","SROCD4",84,0)
 K DIK,DA S DIK="^DD(130,27,1,",DA=1,DA(1)=27,DA(2)=130 D ^DIK
"RTN","SROCD4",85,0)
 K DIK,DA S DIK="^DD(130.275,.01,1,",DA=1,DA(1)=.01,DA(2)=130.275 D ^DIK
"RTN","SROCD4",86,0)
 K DIK,DA S DIK="^DD(130,32.5,1,",DA=1,DA(1)=32.5,DA(2)=130 D ^DIK
"RTN","SROCD4",87,0)
 K DIK,DA S DIK="^DD(130,66,1,",DA=1,DA(1)=66,DA(2)=130 D ^DIK K DIK,DA
"RTN","SROCD4",88,0)
 Q
"RTN","SROPCE")
0^9^B80465090^B75482609
"RTN","SROPCE",1,0)
SROPCE ;BIR/ADM - PCE updates ;10/17/01  9:28 AM
"RTN","SROPCE",2,0)
 ;;3.0;Surgery;**58,62,69,88,105,119,183**;24 Jun 93;Build 14
"RTN","SROPCE",3,0)
 ;
"RTN","SROPCE",4,0)
 ; Reference to $$DATA2PCE^PXAPI supported by DBIA #1889
"RTN","SROPCE",5,0)
 ; Reference to $$DELVFILE^PXAPI supported by DBIA #1890
"RTN","SROPCE",6,0)
 ;
"RTN","SROPCE",7,0)
 Q
"RTN","SROPCE",8,0)
NITE ; entry for nightly update of PCE with surgery & non-OR procedure data
"RTN","SROPCE",9,0)
 N DFN,SR,SRAO,SRATT,SRCHK,SRCPT,SRDATE,SRDIAG,SRDXN,SREC,SRHNC,SRIR,SRCV,SRK,SRLOC,SRMST,SRNAR,SRNON,SROTH,SRPKG,SRPROV,SRS,SRSC,SRTN,SRV,SRVSIT,SRX
"RTN","SROPCE",10,0)
 N SRPLSC,SRPLAO,SRPLIR,SRPLEC,SRPLMST,SRPLHNC,SRPLCV,SRADX,SRADX1,SRCNT,SRD,SRDX,SRRPROV,SRUP,SRINOUT,SRODIAG,SRDXF,SRCLV,SRPLCLV   ;pwc Camp Lejeune SR*3*183
"RTN","SROPCE",11,0)
 K DIC S DIC=9.4,DIC(0)="XM",X="SURGERY" D ^DIC K DIC Q:Y=-1  S SRPKG=+Y
"RTN","SROPCE",12,0)
 S SRS="SURGERY DATA",SRFILE=0 K ^TMP("SRPXAPI",$J)
"RTN","SROPCE",13,0)
 S SRTN=0 F  S SRTN=$O(^SRF("APCE",SRTN)) Q:'SRTN  D UTIL K:SRK ^SRF("APCE",SRTN) I 'SRK D PCE
"RTN","SROPCE",14,0)
 Q
"RTN","SROPCE",15,0)
DEL ; delete data from the Visit file and V files
"RTN","SROPCE",16,0)
 K DA,DIE,DR S DA=SRTN,DIE=130,DR=".015///@" D ^DIE K DA,DIE,DR
"RTN","SROPCE",17,0)
 S SRV=$$DELVFILE^PXAPI("ALL",SRVSIT) K SRVSIT
"RTN","SROPCE",18,0)
 Q
"RTN","SROPCE",19,0)
UTIL ; set procedure variables
"RTN","SROPCE",20,0)
 N SRDIV,SRSITE,SRSR
"RTN","SROPCE",21,0)
 S SRSR="",SRK=0,SRDIV=$P($G(^SRF(SRTN,8)),"^") I SRDIV S SRSITE=$O(^SRO(133,"B",SRDIV,0)),X=^SRO(133,SRSITE,0),SRUP=$P(X,"^",15),SRSR=$P(X,"^",19) I SRUP=""!(SRUP="N") S SRK=1 Q
"RTN","SROPCE",22,0)
 I 'SRFILE S SRX=$G(^SRF("APCE",SRTN)) I SRX S SRVSIT=SRX D DEL I '$D(^SRF(SRTN,0)) S SRK=1 Q
"RTN","SROPCE",23,0)
 S SR(0)=$G(^SRF(SRTN,0)) I SR(0)=""!$P($G(^SRF(SRTN,30)),"^") S SRK=1 Q
"RTN","SROPCE",24,0)
 S DFN=$P(SR(0),"^")
"RTN","SROPCE",25,0)
 S SRNON=$S($P($G(^SRF(SRTN,"NON")),"^")="Y":1,1:0),SRCPT=$P(^SRF(SRTN,"OP"),"^",2) I 'SRCPT S SRK=1 Q
"RTN","SROPCE",26,0)
 S SRX=0 F  S SRX=$O(^SRF(SRTN,13,SRX)) Q:'SRX  I '$P($G(^SRF(SRTN,13,SRX,2)),"^") S SRK=1 Q
"RTN","SROPCE",27,0)
 Q:SRK  S SRDIAG=$P($G(^SRF(SRTN,34)),"^",2) I 'SRDIAG S SRK=1 Q
"RTN","SROPCE",28,0)
 S SRODIAG=$P($G(^SRF(SRTN,34)),"^",3)
"RTN","SROPCE",29,0)
 S SRDXF=$S(SRODIAG=SRDIAG:1,1:0)
"RTN","SROPCE",30,0)
 I 'SRNON D  I SRK Q
"RTN","SROPCE",31,0)
 .S SRX=$P(SR(0),"^",21) I SRX S SRLOC=SRX
"RTN","SROPCE",32,0)
 .I 'SRX S SRX=$P(^SRO(137.45,$P(SR(0),"^",4),0),"^",5) I SRX S SRLOC=SRX
"RTN","SROPCE",33,0)
 .I 'SRX S SRX=$P(SR(0),"^",2) S:SRX SRLOC=$P(^SRS(SRX,0),"^") I 'SRX S SRK=1 Q
"RTN","SROPCE",34,0)
 .S SRX=$G(^SRF(SRTN,.2)),SRCHK=$P(SRX,"^",12) I 'SRCHK S SRK=1 Q
"RTN","SROPCE",35,0)
 .S SRDATE=$P(SRX,"^",10) I 'SRDATE S SRK=1 Q
"RTN","SROPCE",36,0)
 .S SRX=$G(^SRF(SRTN,.1)),SRPROV=$P(SRX,"^",4),SRATT=$P(SRX,"^",13) I 'SRPROV S SRK=1 Q
"RTN","SROPCE",37,0)
 .I SRSR'=0,'SRATT S SRK=1 Q
"RTN","SROPCE",38,0)
 I SRNON D  I SRK Q
"RTN","SROPCE",39,0)
 .S SRLOC=$P(SR(0),"^",21)
"RTN","SROPCE",40,0)
 .S SRX=^SRF(SRTN,"NON"),SRCHK=$P(SRX,"^",5) I 'SRCHK S SRK=1 Q
"RTN","SROPCE",41,0)
 .S SRDATE=$P(SRX,"^",4) I 'SRDATE S SRK=1 Q
"RTN","SROPCE",42,0)
 .I 'SRLOC S SRLOC=$P(SRX,"^",2) I 'SRLOC S SRK=1 Q
"RTN","SROPCE",43,0)
 .S SRPROV=$P(SRX,"^",6),SRATT=$P(SRX,"^",7) I 'SRPROV S SRK=1
"RTN","SROPCE",44,0)
 .I SRSR'=0,'SRATT S SRK=1
"RTN","SROPCE",45,0)
 S VAINDT=SRDATE
"RTN","SROPCE",46,0)
 D INP^VADPT
"RTN","SROPCE",47,0)
 I VAIN(1) S SRINOUT="I"
"RTN","SROPCE",48,0)
 I 'VAIN(1) S SRINOUT="O"
"RTN","SROPCE",49,0)
 K VAINDT,VAIN
"RTN","SROPCE",50,0)
 I '$$CLINIC^SROUTL(SRLOC,SRTN) S SRK=1 Q
"RTN","SROPCE",51,0)
 S SRX=0,SRX=$O(^SRF(SRTN,"PADX",SRX)) I SRX="" S SRK=1 Q
"RTN","SROPCE",52,0)
 S SRX=0 F  S SRX=$O(^SRF(SRTN,13,SRX)) Q:'SRX  I $D(^SRF(SRTN,13,SRX)),'$D(^SRF(SRTN,13,SRX,"OADX")) S SRK=1  Q:SRK
"RTN","SROPCE",53,0)
 S SRX=0 F  S SRX=$O(^SRF(SRTN,15,SRX)) Q:'SRX  I '$P($G(^SRF(SRTN,15,SRX,0)),"^",3) S SRK=1  Q:SRK
"RTN","SROPCE",54,0)
 S SRRPROV="" I $D(^SRF(SRTN,18)) S SRX=0,SRX=$O(^SRF(SRTN,18,SRX)) I SRX S SRRPROV=$P($G(^SRF(SRTN,18,SRX,0)),"^",7)
"RTN","SROPCE",55,0)
 S (SRSC,SRAO,SREC,SRHNC,SRIR,SRMST,SRCV,SRCLV)=0     ;;pwc Camp Lejeune SR*3*183  SRCLV
"RTN","SROPCE",56,0)
 S SRSC=$P(SR(0),"^",16),SRAO=$P(SR(0),"^",17),SRIR=$P(SR(0),"^",18),SREC=$P(SR(0),"^",19),SRMST=$P(SR(0),"^",22),SRHNC=$P(SR(0),"^",23),SRCV=$P(SR(0),"^",24),SRCLV=$P(SR(0),"^",27)
"RTN","SROPCE",57,0)
 Q
"RTN","SROPCE",58,0)
PCE ; set up call to PCE
"RTN","SROPCE",59,0)
 N SRI,SRJ,SRCODE,SROTH D TMP
"RTN","SROPCE",60,0)
D2PCE S SRV=$$DATA2PCE^PXAPI("^TMP(""SRPXAPI"",$J)",SRPKG,SRS,.SRVSIT) I SRVSIT K DA,DIE,DR S DA=SRTN,DIE=130,DR=".015////"_SRVSIT D ^DIE K DA,DIE,DR,^SRF("APCE",SRTN)
"RTN","SROPCE",61,0)
 K ^TMP("SRPXAPI",$J),SRVSIT
"RTN","SROPCE",62,0)
 Q
"RTN","SROPCE",63,0)
TMP ; set up ^TMP global array
"RTN","SROPCE",64,0)
ENC S ^TMP("SRPXAPI",$J,"ENCOUNTER",1,"ENC D/T")=SRDATE
"RTN","SROPCE",65,0)
 S ^TMP("SRPXAPI",$J,"ENCOUNTER",1,"PATIENT")=DFN
"RTN","SROPCE",66,0)
 S ^TMP("SRPXAPI",$J,"ENCOUNTER",1,"HOS LOC")=SRLOC
"RTN","SROPCE",67,0)
 S ^TMP("SRPXAPI",$J,"ENCOUNTER",1,"CHECKOUT D/T")=SRCHK
"RTN","SROPCE",68,0)
 S ^TMP("SRPXAPI",$J,"ENCOUNTER",1,"SERVICE CATEGORY")="S"
"RTN","SROPCE",69,0)
 S ^TMP("SRPXAPI",$J,"ENCOUNTER",1,"ENCOUNTER TYPE")="P"
"RTN","SROPCE",70,0)
 S ^TMP("SRPXAPI",$J,"ENCOUNTER",1,"APPT")=9
"RTN","SROPCE",71,0)
 S ^TMP("SRPXAPI",$J,"ENCOUNTER",1,"SC")=SRSC
"RTN","SROPCE",72,0)
 S ^TMP("SRPXAPI",$J,"ENCOUNTER",1,"AO")=SRAO
"RTN","SROPCE",73,0)
 S ^TMP("SRPXAPI",$J,"ENCOUNTER",1,"IR")=SRIR
"RTN","SROPCE",74,0)
 S ^TMP("SRPXAPI",$J,"ENCOUNTER",1,"EC")=SREC
"RTN","SROPCE",75,0)
 S ^TMP("SRPXAPI",$J,"ENCOUNTER",1,"MST")=SRMST
"RTN","SROPCE",76,0)
 S ^TMP("SRPXAPI",$J,"ENCOUNTER",1,"HNC")=SRHNC
"RTN","SROPCE",77,0)
 S ^TMP("SRPXAPI",$J,"ENCOUNTER",1,"CV")=SRCV
"RTN","SROPCE",78,0)
 S ^TMP("SRPXAPI",$J,"ENCOUNTER",1,"CLV")=SRCLV    ;pwc Camp Lejeune SR*3*183
"RTN","SROPCE",79,0)
PROC S SRI=1,SRCODE=SRCPT,SRNAR=$P(^SRF(SRTN,"OP"),"^") D PMOD,CPT
"RTN","SROPCE",80,0)
 S SROTH=0 F  S SROTH=$O(^SRF(SRTN,13,SROTH)) Q:'SROTH  I $P(^SRF(SRTN,13,SROTH,0),"^",3)'="N" S SRCODE=$P($G(^SRF(SRTN,13,SROTH,2)),"^") I SRCODE S SRNAR=$P(^SRF(SRTN,13,SROTH,0),"^"),SRI=SRI+1 D OMOD,CPT
"RTN","SROPCE",81,0)
PROV S ^TMP("SRPXAPI",$J,"PROVIDER",1,"NAME")=SRPROV
"RTN","SROPCE",82,0)
 S ^TMP("SRPXAPI",$J,"PROVIDER",1,"PRIMARY")=1
"RTN","SROPCE",83,0)
 I 'SRNON S ^TMP("SRPXAPI",$J,"PROVIDER",1,"COMMENT")="Surgeon"
"RTN","SROPCE",84,0)
 I SRPROV=SRATT!'SRATT S ^TMP("SRPXAPI",$J,"PROVIDER",1,"ATTENDING")=1 G DIAG
"RTN","SROPCE",85,0)
 I 'SRATT G DIAG
"RTN","SROPCE",86,0)
 S ^TMP("SRPXAPI",$J,"PROVIDER",2,"NAME")=SRATT
"RTN","SROPCE",87,0)
 S ^TMP("SRPXAPI",$J,"PROVIDER",2,"ATTENDING")=1
"RTN","SROPCE",88,0)
 S ^TMP("SRPXAPI",$J,"PROVIDER",2,"PRIMARY")=0
"RTN","SROPCE",89,0)
 I 'SRNON S ^TMP("SRPXAPI",$J,"PROVIDER",2,"COMMENT")="Attending Surgeon"
"RTN","SROPCE",90,0)
DIAG S SRI=1,SRDX=SRDIAG,SRDXN=$S(SRNON:$P($G(^SRF(SRTN,33)),"^",2),1:$P($G(^SRF(SRTN,34)),"^")) D DX
"RTN","SROPCE",91,0)
 S SRD=0 F  S SRD=$O(^SRF(SRTN,15,SRD)) Q:'SRD  S SRDX=$P(^SRF(SRTN,15,SRD,0),"^",3) I SRDX S SRDXN=$P(^SRF(SRTN,15,SRD,0),"^") D DX
"RTN","SROPCE",92,0)
 I 'SRDXF,SRODIAG D
"RTN","SROPCE",93,0)
 .S ^TMP("SRPXAPI",$J,"DX/PL",SRI,"DIAGNOSIS")=SRODIAG
"RTN","SROPCE",94,0)
 .S ^TMP("SRPXAPI",$J,"DX/PL",SRI,"ORD/RES")="O"
"RTN","SROPCE",95,0)
 .S SRDXN=$P($G(^SRF(SRTN,33)),"^")
"RTN","SROPCE",96,0)
 .I SRDXN'="" S ^TMP("SRPXAPI",$J,"DX/PL",SRI,"NARRATIVE")=SRDXN
"RTN","SROPCE",97,0)
 Q
"RTN","SROPCE",98,0)
DX S ^TMP("SRPXAPI",$J,"DX/PL",SRI,"DIAGNOSIS")=SRDX
"RTN","SROPCE",99,0)
 I SRI=1 D
"RTN","SROPCE",100,0)
 .S ^TMP("SRPXAPI",$J,"DX/PL",1,"PRIMARY")=1
"RTN","SROPCE",101,0)
 .I SRDXF S ^TMP("SRPXAPI",$J,"DX/PL",1,"ORD/RES")="OR"
"RTN","SROPCE",102,0)
 .I 'SRDXF S ^TMP("SRPXAPI",$J,"DX/PL",1,"ORD/RES")="R"
"RTN","SROPCE",103,0)
 .S ^TMP("SRPXAPI",$J,"DX/PL",1,"PL SC")=SRSC
"RTN","SROPCE",104,0)
 .S ^TMP("SRPXAPI",$J,"DX/PL",1,"PL AO")=SRAO
"RTN","SROPCE",105,0)
 .S ^TMP("SRPXAPI",$J,"DX/PL",1,"PL IR")=SRIR
"RTN","SROPCE",106,0)
 .S ^TMP("SRPXAPI",$J,"DX/PL",1,"PL EC")=SREC
"RTN","SROPCE",107,0)
 .S ^TMP("SRPXAPI",$J,"DX/PL",1,"PL MST")=SRMST
"RTN","SROPCE",108,0)
 .S ^TMP("SRPXAPI",$J,"DX/PL",1,"PL HNC")=SRHNC
"RTN","SROPCE",109,0)
 .S ^TMP("SRPXAPI",$J,"DX/PL",1,"PL CV")=SRCV
"RTN","SROPCE",110,0)
 .S ^TMP("SRPXAPI",$J,"DX/PL",1,"PL CLV")=SRCLV   ;pwc Camp Lejeune SR*3*183
"RTN","SROPCE",111,0)
 I SRI'=1 D
"RTN","SROPCE",112,0)
 .S SR(15)=$G(^SRF(SRTN,15,SRD,2))
"RTN","SROPCE",113,0)
 .S (SRPLSC,SRPLAO,SRPLIR,SRPLEC,SRPLMST,SRPLHNC,SRPLCV,SRPLCLV)=0   ;pwc Camp Lejeune SR*3*183  SRPLCLV
"RTN","SROPCE",114,0)
 .S SRPLSC=$P(SR(15),"^",1),SRPLAO=$P(SR(15),"^",2),SRPLIR=$P(SR(15),"^",3),SRPLMST=$P(SR(15),"^",4),SRPLHNC=$P(SR(15),"^",5),SRPLEC=$P(SR(15),"^",6),SRPLCV=$P(SR(15),"^",7),SRPLCLV=$P(SR(15),"^",8)
"RTN","SROPCE",115,0)
 .S ^TMP("SRPXAPI",$J,"DX/PL",SRI,"ORD/RES")="R"
"RTN","SROPCE",116,0)
 .S ^TMP("SRPXAPI",$J,"DX/PL",SRI,"PL SC")=SRPLSC
"RTN","SROPCE",117,0)
 .S ^TMP("SRPXAPI",$J,"DX/PL",SRI,"PL AO")=SRPLAO
"RTN","SROPCE",118,0)
 .S ^TMP("SRPXAPI",$J,"DX/PL",SRI,"PL IR")=SRPLIR
"RTN","SROPCE",119,0)
 .S ^TMP("SRPXAPI",$J,"DX/PL",SRI,"PL EC")=SRPLEC
"RTN","SROPCE",120,0)
 .S ^TMP("SRPXAPI",$J,"DX/PL",SRI,"PL MST")=SRPLMST
"RTN","SROPCE",121,0)
 .S ^TMP("SRPXAPI",$J,"DX/PL",SRI,"PL HNC")=SRPLHNC
"RTN","SROPCE",122,0)
 .S ^TMP("SRPXAPI",$J,"DX/PL",SRI,"PL CV")=SRPLCV
"RTN","SROPCE",123,0)
 .S ^TMP("SRPXAPI",$J,"DX/PL",SRI,"PL CLV")=SRPLCLV   ;pwc Camp Lejeune SR*3*183
"RTN","SROPCE",124,0)
 I SRDXN'="" S ^TMP("SRPXAPI",$J,"DX/PL",SRI,"NARRATIVE")=SRDXN
"RTN","SROPCE",125,0)
 S SRI=SRI+1
"RTN","SROPCE",126,0)
 Q
"RTN","SROPCE",127,0)
CPT S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"ENC PROVIDER")=SRPROV
"RTN","SROPCE",128,0)
 S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"ORD PROVIDER")=SRRPROV
"RTN","SROPCE",129,0)
 S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"EVENT D/T")=SRDATE
"RTN","SROPCE",130,0)
 S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"PROCEDURE")=SRCODE
"RTN","SROPCE",131,0)
 S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"NARRATIVE")=SRNAR
"RTN","SROPCE",132,0)
 S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"QTY")=1
"RTN","SROPCE",133,0)
 S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"COMMENT")=$S(SRI=1:"Principal Procedure",1:"Other Procedure")
"RTN","SROPCE",134,0)
 I SRI=1 D
"RTN","SROPCE",135,0)
 .S SRCNT=1,SRX=0 F  S SRX=$O(^SRF(SRTN,"PADX",SRX)) Q:'SRX  D
"RTN","SROPCE",136,0)
 ..S SRADX1=$P(^SRF(SRTN,"PADX",SRX,0),"^",1)
"RTN","SROPCE",137,0)
 ..I SRADX1=0 S SRADX=SRDIAG  ; 0 IS A FLAG USED TO INDICATE DX IS PRIMARY DX AND NOT OTHER DX
"RTN","SROPCE",138,0)
 ..I SRADX1'=0 S SRADX=$P(^SRF(SRTN,15,SRADX1,0),"^",3)
"RTN","SROPCE",139,0)
 ..I SRCNT=1 S ^TMP("SRPXAPI",$J,"PROCEDURE",1,"DIAGNOSIS")=SRADX
"RTN","SROPCE",140,0)
 ..I SRCNT=2 S ^TMP("SRPXAPI",$J,"PROCEDURE",1,"DIAGNOSIS 2")=SRADX
"RTN","SROPCE",141,0)
 ..I SRCNT=3 S ^TMP("SRPXAPI",$J,"PROCEDURE",1,"DIAGNOSIS 3")=SRADX
"RTN","SROPCE",142,0)
 ..I SRCNT=4 S ^TMP("SRPXAPI",$J,"PROCEDURE",1,"DIAGNOSIS 4")=SRADX
"RTN","SROPCE",143,0)
 ..I SRCNT=5 S ^TMP("SRPXAPI",$J,"PROCEDURE",1,"DIAGNOSIS 5")=SRADX
"RTN","SROPCE",144,0)
 ..I SRCNT=6 S ^TMP("SRPXAPI",$J,"PROCEDURE",1,"DIAGNOSIS 6")=SRADX
"RTN","SROPCE",145,0)
 ..I SRCNT=7 S ^TMP("SRPXAPI",$J,"PROCEDURE",1,"DIAGNOSIS 7")=SRADX
"RTN","SROPCE",146,0)
 ..I SRCNT=8 S ^TMP("SRPXAPI",$J,"PROCEDURE",1,"DIAGNOSIS 8")=SRADX
"RTN","SROPCE",147,0)
 ..S SRCNT=SRCNT+1
"RTN","SROPCE",148,0)
 I SRI'=1 D
"RTN","SROPCE",149,0)
 .S SRCNT=1,SRX=0 F  S SRX=$O(^SRF(SRTN,13,SROTH,"OADX",SRX)) Q:'SRX  D
"RTN","SROPCE",150,0)
 ..S SRADX1=$P(^SRF(SRTN,13,SROTH,"OADX",SRX,0),"^",1)
"RTN","SROPCE",151,0)
 ..I SRADX1=0 S SRADX=SRDIAG  ; 0 IS A FLAG USED TO INDICATE DX IS PRIMARY DX AND NOT OTHER DX
"RTN","SROPCE",152,0)
 ..I SRADX1'=0 S SRADX=$P(^SRF(SRTN,15,SRADX1,0),"^",3)
"RTN","SROPCE",153,0)
 ..I SRCNT=1 S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"DIAGNOSIS")=SRADX
"RTN","SROPCE",154,0)
 ..I SRCNT=2 S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"DIAGNOSIS 2")=SRADX
"RTN","SROPCE",155,0)
 ..I SRCNT=3 S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"DIAGNOSIS 3")=SRADX
"RTN","SROPCE",156,0)
 ..I SRCNT=4 S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"DIAGNOSIS 4")=SRADX
"RTN","SROPCE",157,0)
 ..I SRCNT=5 S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"DIAGNOSIS 5")=SRADX
"RTN","SROPCE",158,0)
 ..I SRCNT=6 S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"DIAGNOSIS 6")=SRADX
"RTN","SROPCE",159,0)
 ..I SRCNT=7 S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"DIAGNOSIS 7")=SRADX
"RTN","SROPCE",160,0)
 ..I SRCNT=8 S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"DIAGNOSIS 8")=SRADX
"RTN","SROPCE",161,0)
 ..S SRCNT=SRCNT+1
"RTN","SROPCE",162,0)
 Q
"RTN","SROPCE",163,0)
PMOD ; get modifiers for principal CPT code
"RTN","SROPCE",164,0)
 N SRM,SRMOD,X
"RTN","SROPCE",165,0)
 S SRM=0 F  S SRM=$O(^SRF(SRTN,"OPMOD",SRM)) Q:'SRM  S X=$P(^SRF(SRTN,"OPMOD",SRM,0),"^"),SRMOD=$P($$MOD^ICPTMOD(X,"I"),"^",2),^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"MODIFIERS",SRMOD)=""
"RTN","SROPCE",166,0)
 S SRMOD="" I $O(^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"MODIFIERS",SRMOD))'="" S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"MODIFIERS")=""
"RTN","SROPCE",167,0)
 Q
"RTN","SROPCE",168,0)
OMOD ; get modifiers for other CPT codes
"RTN","SROPCE",169,0)
 N SRM,SRMOD,X
"RTN","SROPCE",170,0)
 S SRM=0 F  S SRM=$O(^SRF(SRTN,13,SROTH,"MOD",SRM)) Q:'SRM  S X=$P(^SRF(SRTN,13,SROTH,"MOD",SRM,0),"^"),SRMOD=$P($$MOD^ICPTMOD(X,"I"),"^",2),^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"MODIFIERS",SRMOD)=""
"RTN","SROPCE",171,0)
 S SRMOD="" I $O(^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"MODIFIERS",SRMOD))'="" S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"MODIFIERS")=""
"RTN","SROPCE",172,0)
 Q
"RTN","SROPCE1")
0^10^B53162491^B42495285
"RTN","SROPCE1",1,0)
SROPCE1 ;BIR/ADM - ASK SC/EI QUESTIONS FOR PCE AND CROSS REFERENCE LOGIC ;08 Nov 2018  12:45 PM
"RTN","SROPCE1",2,0)
 ;;3.0;Surgery;**58,105,119,150,152,159,177,183**;24 Jun 93;Build 14
"RTN","SROPCE1",3,0)
 ;
"RTN","SROPCE1",4,0)
 ; Reference to CL^SDCO21 supported by DBIA #406
"RTN","SROPCE1",5,0)
 ; Reference to DIS^DGRPDB supported by DBIA #700
"RTN","SROPCE1",6,0)
 ; Reference to Field #.322013 in File #2 supported by DBIA #3475
"RTN","SROPCE1",7,0)
 ;
"RTN","SROPCE1",8,0)
EN1 I '$P(^SRO(133,SRSITE,0),"^",16) Q
"RTN","SROPCE1",9,0)
 N SRPDATE,SRSDATE S SRPDATE=$P(^SRO(133,SRSITE,0),"^",17),SRSDATE=$S($D(SRTN):$P(^SRF(SRTN,0),"^",9),$D(SRWLST):$P(^SRO(133.8,SRSS,1,SROFN,0),"^",5),1:DT) I SRPDATE,SRSDATE<SRPDATE Q
"RTN","SROPCE1",10,0)
 N SRAO,SRDR,SREC,SRELIG,SRIR,SRPERC,SRQ,SRSC,SRCL,SRX,VAEL,VASV,SRCV,SRMST,SRHNC,SRPRJ,SRCLV S SRQ=0   ;pwc SR*3*183 Camp Lejeune SRCLV
"RTN","SROPCE1",11,0)
CLASS ; build classification array
"RTN","SROPCE1",12,0)
 S:$D(SRTN) DFN=$P(^SRF(SRTN,0),"^") D CL^SDCO21(DFN,SRSDATE,,.SRCL)
"RTN","SROPCE1",13,0)
 N CLV D SVC^VADPT S CLV=$G(VASV(15)) I CLV,('$G(SRCL(9))) S SRCL(9)=""   ; set CLV array if CLV SD patch is not released yet and veteran is CLV eligible SR*3*183
"RTN","SROPCE1",14,0)
 I $G(SRW)'="" S:$D(SRW(SRW)) SROFN=$P(SRW(SRW),U,2),SRCL(9)=$P(SRW(SRW),U,15),SRSS=$P(SRW(SRW),U,1)  ;SR*3.0*183
"RTN","SROPCE1",15,0)
 I '$D(SRCL) W !!,"No classification information is required for this patient.",! K DA,DIE,DR S:$D(SRTN) DA=SRTN,DIE=130,DR=".0155////1" S:$D(SRWLST) DA(1)=SRSS,DA=SROFN,DIE="^SRO(133.8,"_DA(1)_",1,",DR="20////1" D ^DIE G END
"RTN","SROPCE1",16,0)
 I $D(SRTN),'$P(^SRF(SRTN,0),"^",20) G ELIG
"RTN","SROPCE1",17,0)
 I $D(SRWLST),'$P($G(^SRO(133.8,SRSS,1,SROFN,0)),"^",20) G ELIG
"RTN","SROPCE1",18,0)
ASK W ! K DIR S DIR("A")="Do you want to update classification information (Y/N)? ",DIR("B")="NO",DIR(0)="YA" D ^DIR K DIR I 'Y!$D(DTOUT)!$D(DUOUT) W:'$D(SRWLST) @IOF Q
"RTN","SROPCE1",19,0)
ELIG ; output of eligibility and service connected conditions
"RTN","SROPCE1",20,0)
 N SRY D DEM^VADPT,ELIG^VADPT,SVC^VADPT
"RTN","SROPCE1",21,0)
 S SRELIG=$P(VAEL(1),"^",2),SRSC=$P(VAEL(3),"^"),SRSC=$S(SRSC:"YES",SRSC=0:"NO",1:""),SRPERC=$P(VAEL(3),"^",2)
"RTN","SROPCE1",22,0)
 S SRAO=$S(VASV(2):"YES",1:"NO"),SRIR=$S(VASV(3):"YES",1:"NO"),SRCV=$S(VASV(10):"YES",1:"NO"),SRPRJ=$S($G(VASV(11)):"YES",1:"NO")
"RTN","SROPCE1",23,0)
 S SRMST=$S($D(SRCL(5)):"YES",1:"NO"),SRHNC=$S($D(SRCL(6)):"YES",1:"NO"),SRCLV=$S($D(SRCL(9)):"YES",1:"NO")    ;pwc Camp Lejeune SR*3*183
"RTN","SROPCE1",24,0)
 S DIC=2,DA=DFN,DR=".322013",DIQ="SRY",DIQ(0)="I" D EN^DIQ1 K DA,DIC,DIQ,DR
"RTN","SROPCE1",25,0)
 S SREC=SRY(2,DFN,.322013,"I"),SREC=$S(SREC="Y":"YES",1:"NO")
"RTN","SROPCE1",26,0)
 W @IOF,!,VADM(1)_"  ("_VA("PID")_")       ",$P(VAEL(6),"^",2),!!,"   * * * Eligibility Information and Service Connected Conditions * * *"
"RTN","SROPCE1",27,0)
 W !!,?5,"Primary Eligibility: "_SRELIG,!,?5,"Combat Vet: "_SRCV,?22,"A/O Exp.: "_SRAO,?39,"M/S Trauma: "_SRMST
"RTN","SROPCE1",28,0)
 W !,?5,"ION Rad.: "_SRIR,?22,"SWAC: "_SREC,?39,"H/N Cancer: "_SRHNC
"RTN","SROPCE1",29,0)
 W !,?5,"PROJ 112/SHAD: "_SRPRJ,?39,"Camp Lejeune: "_SRCLV   ;pwc Camp Lejeune SR*3*183
"RTN","SROPCE1",30,0)
 D DIS^DGRPDB
"RTN","SROPCE1",31,0)
 W ! F I=1:1:79 W "-"
"RTN","SROPCE1",32,0)
SUP S SRY="operation" I $D(SRTN),$P($G(^SRF(SRTN,"NON")),"^")="Y" S SRY="procedure"
"RTN","SROPCE1",33,0)
 K DIR W !!,"Please supply the following required information about this "_SRY_":",! S:$D(SRWLST) DA(1)=SRSS,DA=SROFN S:$D(SRTN) DA=SRTN S SRDR="" S:'$D(SRQ) SRQ=0 D  I SRQ S:$D(SRWLST) SRSOUT=1 G END
"RTN","SROPCE1",34,0)
 .I $D(SRCL(3)) D SC I SRQ Q
"RTN","SROPCE1",35,0)
 .I $D(SRCL(7)) D CV I SRQ Q
"RTN","SROPCE1",36,0)
 .I $D(SRCL(1)) D AO I SRQ Q
"RTN","SROPCE1",37,0)
 .I $D(SRCL(2)) D IR I SRQ Q
"RTN","SROPCE1",38,0)
 .I $D(SRCL(4)) D EC I SRQ Q
"RTN","SROPCE1",39,0)
 .I $D(SRCL(8)) D PRJ I SRQ Q
"RTN","SROPCE1",40,0)
 .I $D(SRCL(5)) D MST I SRQ Q
"RTN","SROPCE1",41,0)
 .I $D(SRCL(6)) D HNC I SRQ Q
"RTN","SROPCE1",42,0)
 .I $D(SRCL(9)) D CLV   ;pwc Camp Lejeune SR*3*183
"RTN","SROPCE1",43,0)
 K DA,DIE,DR S:$D(SRTN) DA=SRTN,DIE=130,DR=SRDR_".0155////1" S:$D(SRWLST) DA(1)=SRSS,DA=SROFN,DIE="^SRO(133.8,"_DA(1)_",1,",DR=SRDR_"20////1"
"RTN","SROPCE1",44,0)
 D ^DIE
"RTN","SROPCE1",45,0)
UPDX I $D(SRTN),X,$D(^SRF(SRTN,15)) D
"RTN","SROPCE1",46,0)
 .R !!,"Update all 'OTHER POSTOP DIAGNOSIS' Eligibility and",!,"Service Connected Conditions with these values?  Enter YES or NO. <NO>",Z:DTIME S:'$T Z=""
"RTN","SROPCE1",47,0)
 .D:(Z["Y")!(Z["y") UPDSC
"RTN","SROPCE1",48,0)
 .I Z["?" D  G UPDX
"RTN","SROPCE1",49,0)
 ..W !!,"Associate all of the existing OTHER POSTOP DIAGNOSIS for this surgical case with the new Eligibility and Service Connected Conditions?"
"RTN","SROPCE1",50,0)
 ..W !,"To edit diagnoses classification status individually, please use the Physician's Verification or the CPT/ICD Coding screens"
"RTN","SROPCE1",51,0)
END K DA,DIE,DR,SRZ,X,Y I 'SRQ,'$D(SRREQ),'$D(SRWLST) D PRESS
"RTN","SROPCE1",52,0)
 Q
"RTN","SROPCE1",53,0)
SC S DIR("A")="Treatment related to Service Connected condition (Y/N)",DIR(0)=$S($D(SRWLST):"133.801,16",1:"130,.016") D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRQ=1 Q
"RTN","SROPCE1",54,0)
 I X=""!(X="@") W !,$C(7),?15,"Enter YES or NO." G SC
"RTN","SROPCE1",55,0)
 S SRCL(3)=Y,SRDR=$G(SRDR)_$S($D(SRWLST):"16",1:".016")_"////"_SRCL(3)_";"
"RTN","SROPCE1",56,0)
 S SRCL(3,"UPDATE")=1
"RTN","SROPCE1",57,0)
 Q
"RTN","SROPCE1",58,0)
CV N SRCVD S SRCVD=$S($D(SRWLST):$P(^SRO(133.8,SRSS,1,SROFN,0),"^",23),1:$P(^SRF(SRTN,0),"^",24)),DIR("B")=$S(SRCVD=0:"NO",1:"YES")
"RTN","SROPCE1",59,0)
 S DIR("A")="Treatment related to Combat (Y/N)",DIR(0)=$S($D(SRWLST):"133.801,23",1:"130,.024") D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRQ=1 Q
"RTN","SROPCE1",60,0)
 I X=""!(X="@") W !,$C(7),?15,"Enter YES or NO." G CV
"RTN","SROPCE1",61,0)
 S SRCL(7)=Y,SRDR=SRDR_$S($D(SRWLST):"23",1:".024")_"////"_SRCL(7)_";"
"RTN","SROPCE1",62,0)
 S SRCL(7,"UPDATE")=1
"RTN","SROPCE1",63,0)
 Q
"RTN","SROPCE1",64,0)
AO S DIR("A")="Treatment related to Agent Orange Exposure (Y/N)",DIR(0)=$S($D(SRWLST):"133.801,17",1:"130,.017") D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRQ=1 Q
"RTN","SROPCE1",65,0)
 I X=""!(X="@") W !,$C(7),?15,"Enter YES or NO." G AO
"RTN","SROPCE1",66,0)
 S SRCL(1)=Y,SRDR=SRDR_$S($D(SRWLST):"17",1:".017")_"////"_SRCL(1)_";"
"RTN","SROPCE1",67,0)
 S SRCL(1,"UPDATE")=1
"RTN","SROPCE1",68,0)
 Q
"RTN","SROPCE1",69,0)
IR S DIR("A")="Treatment related to Ionizing Radiation Exposure (Y/N)",DIR(0)=$S($D(SRWLST):"133.801,18",1:"130,.018") D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRQ=1 Q
"RTN","SROPCE1",70,0)
 I X=""!(X="@") W !,$C(7),?15,"Enter YES or NO." G IR
"RTN","SROPCE1",71,0)
 S SRCL(2)=Y,SRDR=SRDR_$S($D(SRWLST):"18",1:".018")_"////"_SRCL(2)_";"
"RTN","SROPCE1",72,0)
 S SRCL(2,"UPDATE")=1
"RTN","SROPCE1",73,0)
 Q
"RTN","SROPCE1",74,0)
EC S DIR("A")="Treatment related to SW Asia (Y/N)",DIR(0)=$S($D(SRWLST):"133.801,19",1:"130,.019") D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRQ=1 Q
"RTN","SROPCE1",75,0)
 I X=""!(X="@") W !,$C(7),?15,"Enter YES or NO." G EC
"RTN","SROPCE1",76,0)
 S SRCL(4)=Y,SRDR=SRDR_$S($D(SRWLST):"19",1:".019")_"////"_SRCL(4)_";"
"RTN","SROPCE1",77,0)
 S SRCL(4,"UPDATE")=1
"RTN","SROPCE1",78,0)
 Q
"RTN","SROPCE1",79,0)
PRJ S DIR("A")="Treatment related to PROJ 112/SHAD (Y/N)",DIR(0)=$S($D(SRWLST):"133.801,24",1:"130,.026") D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRQ=1 Q
"RTN","SROPCE1",80,0)
 I X=""!(X="@") W !,$C(7),?15,"Enter YES or NO." G PRJ
"RTN","SROPCE1",81,0)
 S SRCL(8)=Y,SRDR=SRDR_$S($D(SRWLST):"24",1:".026")_"////"_SRCL(8)_";"
"RTN","SROPCE1",82,0)
 S SRCL(8,"UPDATE")=1
"RTN","SROPCE1",83,0)
 Q
"RTN","SROPCE1",84,0)
MST S DIR("A")="Treatment related to Military Sexual Trauma (Y/N)",DIR(0)=$S($D(SRWLST):"133.801,21",1:"130,.022") D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRQ=1 Q
"RTN","SROPCE1",85,0)
 I X=""!(X="@") W !,$C(7),?15,"Enter YES or NO." G MST
"RTN","SROPCE1",86,0)
 S SRCL(5)=Y,SRDR=SRDR_$S($D(SRWLST):"21",1:".022")_"////"_SRCL(5)_";"
"RTN","SROPCE1",87,0)
 S SRCL(5,"UPDATE")=1
"RTN","SROPCE1",88,0)
 Q
"RTN","SROPCE1",89,0)
HNC S DIR("A")="Treatment related to Head and/or Neck Cancer (Y/N)",DIR(0)=$S($D(SRWLST):"133.801,22",1:"130,.023") D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRQ=1 Q
"RTN","SROPCE1",90,0)
 I X=""!(X="@") W !,$C(7),?15,"Enter YES or NO." G HNC
"RTN","SROPCE1",91,0)
 S SRCL(6)=Y,SRDR=SRDR_$S($D(SRWLST):"22",1:".023")_"////"_SRCL(6)_";"
"RTN","SROPCE1",92,0)
 S SRCL(6,"UPDATE")=1
"RTN","SROPCE1",93,0)
 Q
"RTN","SROPCE1",94,0)
 ; pwc Camp Lejeune SR*3*183
"RTN","SROPCE1",95,0)
CLV S DIR("A")="Treatment related to Camp Lejeune (Y/N)",DIR(0)=$S($D(SRWLST):"133.801,25",1:"130,.027") D CLVB,^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRQ=1 Q
"RTN","SROPCE1",96,0)
 I X=""!(X="@") W !,$C(7),?15,"Enter YES or NO." G CLV
"RTN","SROPCE1",97,0)
 S SRCL(9)=Y,SRDR=SRDR_$S($D(SRWLST):"25",1:".027")_"////"_SRCL(9)_";"
"RTN","SROPCE1",98,0)
 S SRCL(9,"UPDATE")=1
"RTN","SROPCE1",99,0)
 Q
"RTN","SROPCE1",100,0)
CLVB ;CREATE DIR("B")
"RTN","SROPCE1",101,0)
 Q:'$D(SRWLST)
"RTN","SROPCE1",102,0)
 I $D(SRW) S:$G(SRW(SRW))'="" SRDA=$P(SRW(SRW),U,2)
"RTN","SROPCE1",103,0)
 Q:'$D(SRDA)
"RTN","SROPCE1",104,0)
 N IENS S IENS=SRDA_","_SRSS S SRCL(9)=$$GET1^DIQ(133.801,IENS_",",25,"I")
"RTN","SROPCE1",105,0)
 I $D(SRW(SRW)) S SRCL(9)=$P(SRW(SRW),U,15)
"RTN","SROPCE1",106,0)
 I $G(SRCL(9))="" S DIR("B")="NO" Q
"RTN","SROPCE1",107,0)
 I $G(SRCL(9))'="" S DIR("B")=$S(SRCL(9)=1:"YES",1:"NO")
"RTN","SROPCE1",108,0)
 Q
"RTN","SROPCE1",109,0)
WL ; entry from waiting list
"RTN","SROPCE1",110,0)
 N SRWLST S SRWLST=1 G EN1
"RTN","SROPCE1",111,0)
 Q
"RTN","SROPCE1",112,0)
REQ ; entry from new request entry
"RTN","SROPCE1",113,0)
 N SRREQ S SRREQ=1 G EN1
"RTN","SROPCE1",114,0)
PRESS W ! K DIR S DIR("A")="Press RETURN to continue  ",DIR(0)="FOA" D ^DIR K DIR W @IOF
"RTN","SROPCE1",115,0)
 Q
"RTN","SROPCE1",116,0)
UPDSC ;Update existing DX to Service Connected/Environmental Indicators associations.
"RTN","SROPCE1",117,0)
 K DA,DIE
"RTN","SROPCE1",118,0)
 S (DA,I)=0,DA(1)=SRTN,DIE="^SRF("_SRTN_",15,"
"RTN","SROPCE1",119,0)
 K DR
"RTN","SROPCE1",120,0)
 D:$D(SRCL(1,"UPDATE")) BLDDR(5,SRCL(1))
"RTN","SROPCE1",121,0)
 D:$D(SRCL(2,"UPDATE")) BLDDR(6,SRCL(2))
"RTN","SROPCE1",122,0)
 D:$D(SRCL(3,"UPDATE")) BLDDR(4,SRCL(3))
"RTN","SROPCE1",123,0)
 D:$D(SRCL(4,"UPDATE")) BLDDR(9,SRCL(4))
"RTN","SROPCE1",124,0)
 D:$D(SRCL(5,"UPDATE")) BLDDR(7,SRCL(5))
"RTN","SROPCE1",125,0)
 D:$D(SRCL(6,"UPDATE")) BLDDR(8,SRCL(6))
"RTN","SROPCE1",126,0)
 D:$D(SRCL(7,"UPDATE")) BLDDR(10,SRCL(7))
"RTN","SROPCE1",127,0)
 D:$D(SRCL(8,"UPDATE")) BLDDR(11,SRCL(8))
"RTN","SROPCE1",128,0)
 D:$D(SRCL(9,"UPDATE")) BLDDR(12,SRCL(9))   ;pwc Camp Lejeune SR*3*183
"RTN","SROPCE1",129,0)
 F I=1:1 S DA=$O(^SRF(SRTN,15,DA)) Q:DA=""  D ^DIE
"RTN","SROPCE1",130,0)
 Q
"RTN","SROPCE1",131,0)
BLDDR(DXPIECE,NEWSC) ;Build the DR string for updating DX/Service Indicators associations
"RTN","SROPCE1",132,0)
 S:$D(DR) DR=DR_";"
"RTN","SROPCE1",133,0)
 S:'$D(DR) DR=""
"RTN","SROPCE1",134,0)
 S DR=DR_DXPIECE_"///"_NEWSC
"RTN","SROPCE1",135,0)
 K DXPIECE,NEWSC
"RTN","SROPCE1",136,0)
 Q
"RTN","SROPCEP")
0^11^B84721073^B80453673
"RTN","SROPCEP",1,0)
SROPCEP ;BIR/TJH - PCE UPDATES ;04/26/05  9:28 AM
"RTN","SROPCEP",2,0)
 ;;3.0;Surgery;**142,152,144,161,183**;24 Jun 93;Build 14
"RTN","SROPCEP",3,0)
 ;
"RTN","SROPCEP",4,0)
 ; Reference to $$DATA2PCE^PXAPI supported by DBIA #1889
"RTN","SROPCEP",5,0)
 ; Reference to $$DELVFILE^PXAPI supported by DBIA #1890
"RTN","SROPCEP",6,0)
 ; Reference to ^DIC(45.3 is supported by DBIA #218
"RTN","SROPCEP",7,0)
 ;
"RTN","SROPCEP",8,0)
 Q
"RTN","SROPCEP",9,0)
START ; entry for update to PCE with surgery & non-OR procedure data
"RTN","SROPCEP",10,0)
 I '$D(SRTN) S SRTN=$G(DA)
"RTN","SROPCEP",11,0)
 I SRTN="" Q
"RTN","SROPCEP",12,0)
 N DFN,SR,SRAO,SRATT,SRCHK,SRCPT,SRDATE,SRDIAG,SREC,SRHNC,SRIR,SRCV,SRPRJ,SRK,SRLOC,SRMST,SRNON,SROTH,SRPKG,SRPROV,SRS,SRSC,SRV,SRVSIT,SRX,SRX2
"RTN","SROPCEP",13,0)
 N SRPLSC,SRPLAO,SRPLIR,SRPLEC,SRPLMST,SRPLHNC,SRPLCV,SRPLPRJ,SRADX,SRCNT,SRD,SRDX,SRRPROV,SRUP,SRINOUT,SRO,SRDEPC,SRPFSSAR,SRPLCLV  ;pwc Camp Lejeune SR*3*183
"RTN","SROPCEP",14,0)
 N SRDP,SRDC,SRDI,SRDL,SRDIE,SRDG,SRDM,SRDR,SRDH,SRDK,SRDA,SRD0,SRDDER,SRDG,SRDIC,SRDIC1,SRDICRRE,SRDIEDA,SRDIG,SRDIH,SRDIIENS,SRDISL,SRDISYS,SRDIU,SRDIV,SRDIWT,SRDN,SRDQ,SRDX,SRDY
"RTN","SROPCEP",15,0)
 D FM1 K DIC S DIC=9.4,DIC(0)="XM",X="SURGERY" D ^DIC K DIC D FM2 Q:Y=-1  S SRPKG=+Y
"RTN","SROPCEP",16,0)
 S SRS="SURGERY DATA" K ^TMP("SRPXAPI",$J)
"RTN","SROPCEP",17,0)
 D UTIL I 'SRK D PCE
"RTN","SROPCEP",18,0)
 Q
"RTN","SROPCEP",19,0)
DEL ; delete data from the Visit file and V files
"RTN","SROPCEP",20,0)
 D FM1 K DA,DIE,DR S DA=SRTN,DIE=130,DR=".015///@" D ^DIE K DA,DIE,DR D FM2
"RTN","SROPCEP",21,0)
 D FM1 S SRV=$$DELVFILE^PXAPI("ALL",SRVSIT) K SRVSIT D FM2
"RTN","SROPCEP",22,0)
 Q
"RTN","SROPCEP",23,0)
UTIL ; set procedure variables
"RTN","SROPCEP",24,0)
 N SRDIV,SRSITE,SRSR
"RTN","SROPCEP",25,0)
 S SRSR="",SRK=0,SRDIV=$P($G(^SRF(SRTN,8)),"^") I SRDIV S SRSITE=$O(^SRO(133,"B",SRDIV,0)),X=^SRO(133,SRSITE,0),SRUP=$P(X,"^",15),SRSR=$P(X,"^",19) I SRUP=""!(SRUP="N") S SRK=1 Q
"RTN","SROPCEP",26,0)
 S SRX=$P($G(^SRF(SRTN,0)),"^",15) I SRX S SRVSIT=SRX D DEL I '$D(^SRF(SRTN,0)) S SRK=1 Q
"RTN","SROPCEP",27,0)
 S SR(0)=$G(^SRF(SRTN,0)) I SR(0)=""!$P($G(^SRF(SRTN,30)),"^") S SRK=1 Q
"RTN","SROPCEP",28,0)
 S DFN=$P(SR(0),"^")
"RTN","SROPCEP",29,0)
 S SRNON=$S($P($G(^SRF(SRTN,"NON")),"^")="Y":1,1:0),SRCPT=$P($G(^SRO(136,SRTN,0)),"^",2) I 'SRCPT S SRK=1 Q
"RTN","SROPCEP",30,0)
 Q:SRK  S SRDIAG=$P($G(^SRO(136,SRTN,0)),"^",3) I 'SRDIAG S SRK=1 Q
"RTN","SROPCEP",31,0)
 I 'SRNON D  I SRK Q
"RTN","SROPCEP",32,0)
 .S SRX=$P(SR(0),"^",21) I SRX S SRLOC=SRX
"RTN","SROPCEP",33,0)
 .I 'SRX S SRX=$P(^SRO(137.45,$P(SR(0),"^",4),0),"^",5) I SRX S SRLOC=SRX
"RTN","SROPCEP",34,0)
 .I 'SRX S SRX=$P(SR(0),"^",2) S:SRX SRLOC=$P(^SRS(SRX,0),"^") I 'SRX S SRK=1 Q
"RTN","SROPCEP",35,0)
 .S SRX=$G(^SRF(SRTN,.2)),SRCHK=$P(SRX,"^",12) I 'SRCHK S SRK=1 Q
"RTN","SROPCEP",36,0)
 .S SRDATE=$P(SRX,"^",10) I 'SRDATE S SRK=1 Q
"RTN","SROPCEP",37,0)
 .S SRX=$G(^SRF(SRTN,.1)),SRPROV=$P(SRX,"^",4),SRATT=$P(SRX,"^",13) I 'SRPROV S SRK=1 Q
"RTN","SROPCEP",38,0)
 .I SRSR'=0,'SRATT S SRK=1 Q
"RTN","SROPCEP",39,0)
 I SRNON D  I SRK Q
"RTN","SROPCEP",40,0)
 .S SRLOC=$P(SR(0),"^",21)
"RTN","SROPCEP",41,0)
 .S SRX=^SRF(SRTN,"NON"),SRCHK=$P(SRX,"^",5) I 'SRCHK S SRK=1 Q
"RTN","SROPCEP",42,0)
 .S SRDATE=$P(SRX,"^",4) I 'SRDATE S SRK=1 Q
"RTN","SROPCEP",43,0)
 .I 'SRLOC S SRLOC=$P(SRX,"^",2) I 'SRLOC S SRK=1 Q
"RTN","SROPCEP",44,0)
 .S SRPROV=$P(SRX,"^",6),SRATT=$P(SRX,"^",7) I 'SRPROV S SRK=1
"RTN","SROPCEP",45,0)
 .I SRSR'=0,'SRATT S SRK=1
"RTN","SROPCEP",46,0)
 S VAINDT=SRDATE
"RTN","SROPCEP",47,0)
 D INP^VADPT
"RTN","SROPCEP",48,0)
 I VAIN(1) S SRINOUT="I"
"RTN","SROPCEP",49,0)
 I 'VAIN(1) S SRINOUT="O"
"RTN","SROPCEP",50,0)
 K VAINDT,VAIN
"RTN","SROPCEP",51,0)
 I '$$CLINIC^SROUTL(SRLOC,SRTN) S SRK=1 Q
"RTN","SROPCEP",52,0)
 S SRX=0,SRX=$O(^SRO(136,SRTN,2,SRX)) I SRX="" S SRK=1 Q
"RTN","SROPCEP",53,0)
 S SRX=0 F  S SRX=$O(^SRO(136,SRTN,3,SRX)) Q:'SRX  S SRX2=0,SRX2=$O(^SRO(136,SRTN,3,SRX,2,SRX2)) I $D(^SRO(136,SRTN,3,SRX,0)),(SRX2="") S SRK=1  Q:SRK
"RTN","SROPCEP",54,0)
 S SRRPROV="" I $D(^SRF(SRTN,18)) S SRX=0,SRX=$O(^SRF(SRTN,18,SRX)) I SRX S SRRPROV=$P($G(^SRF(SRTN,18,SRX,0)),"^",7)
"RTN","SROPCEP",55,0)
 S SRO(0)=$G(^SRO(136,SRTN,0))
"RTN","SROPCEP",56,0)
 S (SRSC,SRAO,SREC,SRHNC,SRIR,SRMST,SRCV,SRPRJ)=0,SRSC=$P(SRO(0),"^",4),SRAO=$P(SRO(0),"^",5),SRIR=$P(SRO(0),"^",6),SREC=$P(SRO(0),"^",7)
"RTN","SROPCEP",57,0)
 S SRMST=$P(SRO(0),"^",8),SRHNC=$P(SRO(0),"^",9),SRCV=$P(SRO(0),"^",10),SRPRJ=$P(SRO(0),"^",11),SRCLV=$P(SRO(0),"^",12)   ;pwc Camp Lejeune SR*3*183
"RTN","SROPCEP",58,0)
 I $$SWSTAT^IBBAPI(),'SRNON D
"RTN","SROPCEP",59,0)
 .S SRX=$P(^SRO(137.45,$P(SR(0),"^",4),0),"^",2)
"RTN","SROPCEP",60,0)
 .I SRX S SRDEPC=$$GET1^DIQ(45.3,SRX,2)
"RTN","SROPCEP",61,0)
 Q
"RTN","SROPCEP",62,0)
PCE ;
"RTN","SROPCEP",63,0)
 N SRI,SRJ,SRCODE,SROTH D TMP
"RTN","SROPCEP",64,0)
D2PCE ;
"RTN","SROPCEP",65,0)
 S SRPFSSAR=$P($G(^SRF(SRTN,"PFSS")),"^")
"RTN","SROPCEP",66,0)
 I $$SWSTAT^IBBAPI() D FM1 S SRV=$$DATA2PCE^PXAPI("^TMP(""SRPXAPI"",$J)",SRPKG,SRS,.SRVSIT,,,,,,.SRPFSSAR) D FM2
"RTN","SROPCEP",67,0)
 I '$$SWSTAT^IBBAPI() D FM1 S SRV=$$DATA2PCE^PXAPI("^TMP(""SRPXAPI"",$J)",SRPKG,SRS,.SRVSIT) D FM2
"RTN","SROPCEP",68,0)
 I SRVSIT D FM1 K DA,DIE,DR S DA=SRTN,DIE=130,DR=".015////"_SRVSIT D ^DIE K DA,DIE,DR D FM2
"RTN","SROPCEP",69,0)
 K ^TMP("SRPXAPI",$J),SRVSIT
"RTN","SROPCEP",70,0)
 Q
"RTN","SROPCEP",71,0)
TMP ;
"RTN","SROPCEP",72,0)
ENC S ^TMP("SRPXAPI",$J,"ENCOUNTER",1,"ENC D/T")=SRDATE
"RTN","SROPCEP",73,0)
 S ^TMP("SRPXAPI",$J,"ENCOUNTER",1,"PATIENT")=DFN
"RTN","SROPCEP",74,0)
 S ^TMP("SRPXAPI",$J,"ENCOUNTER",1,"HOS LOC")=SRLOC
"RTN","SROPCEP",75,0)
 S ^TMP("SRPXAPI",$J,"ENCOUNTER",1,"CHECKOUT D/T")=SRCHK
"RTN","SROPCEP",76,0)
 S ^TMP("SRPXAPI",$J,"ENCOUNTER",1,"SERVICE CATEGORY")="S"
"RTN","SROPCEP",77,0)
 S ^TMP("SRPXAPI",$J,"ENCOUNTER",1,"ENCOUNTER TYPE")="P"
"RTN","SROPCEP",78,0)
 S ^TMP("SRPXAPI",$J,"ENCOUNTER",1,"APPT")=9
"RTN","SROPCEP",79,0)
 S ^TMP("SRPXAPI",$J,"ENCOUNTER",1,"SC")=SRSC
"RTN","SROPCEP",80,0)
 S ^TMP("SRPXAPI",$J,"ENCOUNTER",1,"AO")=SRAO
"RTN","SROPCEP",81,0)
 S ^TMP("SRPXAPI",$J,"ENCOUNTER",1,"IR")=SRIR
"RTN","SROPCEP",82,0)
 S ^TMP("SRPXAPI",$J,"ENCOUNTER",1,"EC")=SREC
"RTN","SROPCEP",83,0)
 S ^TMP("SRPXAPI",$J,"ENCOUNTER",1,"MST")=SRMST
"RTN","SROPCEP",84,0)
 S ^TMP("SRPXAPI",$J,"ENCOUNTER",1,"HNC")=SRHNC
"RTN","SROPCEP",85,0)
 S ^TMP("SRPXAPI",$J,"ENCOUNTER",1,"CV")=SRCV
"RTN","SROPCEP",86,0)
 S ^TMP("SRPXAPI",$J,"ENCOUNTER",1,"SHAD")=SRPRJ
"RTN","SROPCEP",87,0)
 S ^TMP("SRPXAPI",$J,"ENCOUNTER",1,"CLV")=SRCLV    ;pwc Camp Lejeune SR*3*183
"RTN","SROPCEP",88,0)
PROC S SRI=1,SRCODE=SRCPT D PMOD,CPT
"RTN","SROPCEP",89,0)
 S SROTH=0 F  S SROTH=$O(^SRO(136,SRTN,3,SROTH)) Q:'SROTH  S SRCODE=$P($G(^SRO(136,SRTN,3,SROTH,0)),"^") I SRCODE S SRI=SRI+1 D OMOD,CPT
"RTN","SROPCEP",90,0)
PROV S ^TMP("SRPXAPI",$J,"PROVIDER",1,"NAME")=SRPROV
"RTN","SROPCEP",91,0)
 S ^TMP("SRPXAPI",$J,"PROVIDER",1,"PRIMARY")=1
"RTN","SROPCEP",92,0)
 I 'SRNON S ^TMP("SRPXAPI",$J,"PROVIDER",1,"COMMENT")="Surgeon"
"RTN","SROPCEP",93,0)
 I SRPROV=SRATT!'SRATT S ^TMP("SRPXAPI",$J,"PROVIDER",1,"ATTENDING")=1 G DIAG
"RTN","SROPCEP",94,0)
 I 'SRATT G DIAG
"RTN","SROPCEP",95,0)
 S ^TMP("SRPXAPI",$J,"PROVIDER",2,"NAME")=SRATT
"RTN","SROPCEP",96,0)
 S ^TMP("SRPXAPI",$J,"PROVIDER",2,"ATTENDING")=1
"RTN","SROPCEP",97,0)
 S ^TMP("SRPXAPI",$J,"PROVIDER",2,"PRIMARY")=1
"RTN","SROPCEP",98,0)
 S ^TMP("SRPXAPI",$J,"PROVIDER",1,"PRIMARY")=0
"RTN","SROPCEP",99,0)
 I 'SRNON S ^TMP("SRPXAPI",$J,"PROVIDER",2,"COMMENT")="Attending Surgeon"
"RTN","SROPCEP",100,0)
DIAG S SRI=1,SRDX=SRDIAG D DX
"RTN","SROPCEP",101,0)
 S SRD=0 F  S SRD=$O(^SRO(136,SRTN,4,SRD)) Q:'SRD  S SRDX=$P(^SRO(136,SRTN,4,SRD,0),"^") I SRDX D DX
"RTN","SROPCEP",102,0)
 Q
"RTN","SROPCEP",103,0)
DX S ^TMP("SRPXAPI",$J,"DX/PL",SRI,"DIAGNOSIS")=SRDX
"RTN","SROPCEP",104,0)
 I SRI=1 D
"RTN","SROPCEP",105,0)
 .S ^TMP("SRPXAPI",$J,"DX/PL",1,"PRIMARY")=1
"RTN","SROPCEP",106,0)
 .S ^TMP("SRPXAPI",$J,"DX/PL",1,"ORD/RES")="R"
"RTN","SROPCEP",107,0)
 .S ^TMP("SRPXAPI",$J,"DX/PL",1,"PL SC")=SRSC
"RTN","SROPCEP",108,0)
 .S ^TMP("SRPXAPI",$J,"DX/PL",1,"PL AO")=SRAO
"RTN","SROPCEP",109,0)
 .S ^TMP("SRPXAPI",$J,"DX/PL",1,"PL IR")=SRIR
"RTN","SROPCEP",110,0)
 .S ^TMP("SRPXAPI",$J,"DX/PL",1,"PL EC")=SREC
"RTN","SROPCEP",111,0)
 .S ^TMP("SRPXAPI",$J,"DX/PL",1,"PL MST")=SRMST
"RTN","SROPCEP",112,0)
 .S ^TMP("SRPXAPI",$J,"DX/PL",1,"PL HNC")=SRHNC
"RTN","SROPCEP",113,0)
 .S ^TMP("SRPXAPI",$J,"DX/PL",1,"PL CV")=SRCV
"RTN","SROPCEP",114,0)
 .S ^TMP("SRPXAPI",$J,"DX/PL",1,"PL SHAD")=SRPRJ
"RTN","SROPCEP",115,0)
 .S ^TMP("SRPXAPI",$J,"DX/PL",1,"PL CLV")=SRCLV     ;pwc Camp Lejeune SR*3*183
"RTN","SROPCEP",116,0)
 I SRI'=1 D
"RTN","SROPCEP",117,0)
 .S SR(4)=$G(^SRO(136,SRTN,4,SRD,0))
"RTN","SROPCEP",118,0)
 .S (SRPLSC,SRPLAO,SRPLIR,SRPLEC,SRPLMST,SRPLHNC,SRPLCV,SRPLPRJ)=0,SRPLSC=$P(SR(4),"^",2),SRPLAO=$P(SR(4),"^",3)
"RTN","SROPCEP",119,0)
 .S SRPLIR=$P(SR(4),"^",4),SRPLMST=$P(SR(4),"^",5),SRPLHNC=$P(SR(4),"^",6),SRPLEC=$P(SR(4),"^",7),SRPLCV=$P(SR(4),"^",8),SRPLPRJ=$P(SR(4),"^",9),SRPLCLV=$P(SR(4),"^",10)
"RTN","SROPCEP",120,0)
 .S ^TMP("SRPXAPI",$J,"DX/PL",SRI,"ORD/RES")="R"
"RTN","SROPCEP",121,0)
 .S ^TMP("SRPXAPI",$J,"DX/PL",SRI,"PL SC")=SRPLSC
"RTN","SROPCEP",122,0)
 .S ^TMP("SRPXAPI",$J,"DX/PL",SRI,"PL AO")=SRPLAO
"RTN","SROPCEP",123,0)
 .S ^TMP("SRPXAPI",$J,"DX/PL",SRI,"PL IR")=SRPLIR
"RTN","SROPCEP",124,0)
 .S ^TMP("SRPXAPI",$J,"DX/PL",SRI,"PL EC")=SRPLEC
"RTN","SROPCEP",125,0)
 .S ^TMP("SRPXAPI",$J,"DX/PL",SRI,"PL MST")=SRPLMST
"RTN","SROPCEP",126,0)
 .S ^TMP("SRPXAPI",$J,"DX/PL",SRI,"PL HNC")=SRPLHNC
"RTN","SROPCEP",127,0)
 .S ^TMP("SRPXAPI",$J,"DX/PL",SRI,"PL CV")=SRPLCV
"RTN","SROPCEP",128,0)
 .S ^TMP("SRPXAPI",$J,"DX/PL",SRI,"PL SHAD")=SRPLPRJ
"RTN","SROPCEP",129,0)
 .S ^TMP("SRPXAPI",$J,"DX/PL",SRI,"PL CLV")=SRPLCLV  ;pwc Camp Lejeune SR*3*183
"RTN","SROPCEP",130,0)
 S SRI=SRI+1
"RTN","SROPCEP",131,0)
 Q
"RTN","SROPCEP",132,0)
CPT S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"ENC PROVIDER")=$S($P($G(^SRF(SRTN,.1)),"^",3)="R":SRATT,1:SRPROV)  ;; << *161 RJS
"RTN","SROPCEP",133,0)
 S:SRRPROV'="" ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"ORD PROVIDER")=SRRPROV
"RTN","SROPCEP",134,0)
 S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"EVENT D/T")=SRDATE
"RTN","SROPCEP",135,0)
 S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"PROCEDURE")=SRCODE
"RTN","SROPCEP",136,0)
 S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"QTY")=1
"RTN","SROPCEP",137,0)
 S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"COMMENT")=$S(SRI=1:"Principal Procedure",1:"Other Procedure")
"RTN","SROPCEP",138,0)
 I $G(SRDEPC) S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"DEPARTMENT")=SRDEPC
"RTN","SROPCEP",139,0)
 I SRI=1 D
"RTN","SROPCEP",140,0)
 .S SRCNT=1,SRX=0 F  S SRX=$O(^SRO(136,SRTN,2,SRX)) Q:'SRX  D
"RTN","SROPCEP",141,0)
 ..S SRADX=$P(^SRO(136,SRTN,2,SRX,0),"^")
"RTN","SROPCEP",142,0)
 ..I SRCNT=1 S ^TMP("SRPXAPI",$J,"PROCEDURE",1,"DIAGNOSIS")=SRADX
"RTN","SROPCEP",143,0)
 ..I SRCNT=2 S ^TMP("SRPXAPI",$J,"PROCEDURE",1,"DIAGNOSIS 2")=SRADX
"RTN","SROPCEP",144,0)
 ..I SRCNT=3 S ^TMP("SRPXAPI",$J,"PROCEDURE",1,"DIAGNOSIS 3")=SRADX
"RTN","SROPCEP",145,0)
 ..I SRCNT=4 S ^TMP("SRPXAPI",$J,"PROCEDURE",1,"DIAGNOSIS 4")=SRADX
"RTN","SROPCEP",146,0)
 ..I SRCNT=5 S ^TMP("SRPXAPI",$J,"PROCEDURE",1,"DIAGNOSIS 5")=SRADX
"RTN","SROPCEP",147,0)
 ..I SRCNT=6 S ^TMP("SRPXAPI",$J,"PROCEDURE",1,"DIAGNOSIS 6")=SRADX
"RTN","SROPCEP",148,0)
 ..I SRCNT=7 S ^TMP("SRPXAPI",$J,"PROCEDURE",1,"DIAGNOSIS 7")=SRADX
"RTN","SROPCEP",149,0)
 ..I SRCNT=8 S ^TMP("SRPXAPI",$J,"PROCEDURE",1,"DIAGNOSIS 8")=SRADX
"RTN","SROPCEP",150,0)
 ..S SRCNT=SRCNT+1
"RTN","SROPCEP",151,0)
 I SRI'=1 D
"RTN","SROPCEP",152,0)
 .S SRCNT=1,SRX=0 F  S SRX=$O(^SRO(136,SRTN,3,SROTH,2,SRX)) Q:'SRX  D
"RTN","SROPCEP",153,0)
 ..S SRADX=$P(^SRO(136,SRTN,3,SROTH,2,SRX,0),"^")
"RTN","SROPCEP",154,0)
 ..I SRCNT=1 S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"DIAGNOSIS")=SRADX
"RTN","SROPCEP",155,0)
 ..I SRCNT=2 S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"DIAGNOSIS 2")=SRADX
"RTN","SROPCEP",156,0)
 ..I SRCNT=3 S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"DIAGNOSIS 3")=SRADX
"RTN","SROPCEP",157,0)
 ..I SRCNT=4 S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"DIAGNOSIS 4")=SRADX
"RTN","SROPCEP",158,0)
 ..I SRCNT=5 S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"DIAGNOSIS 5")=SRADX
"RTN","SROPCEP",159,0)
 ..I SRCNT=6 S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"DIAGNOSIS 6")=SRADX
"RTN","SROPCEP",160,0)
 ..I SRCNT=7 S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"DIAGNOSIS 7")=SRADX
"RTN","SROPCEP",161,0)
 ..I SRCNT=8 S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"DIAGNOSIS 8")=SRADX
"RTN","SROPCEP",162,0)
 ..S SRCNT=SRCNT+1
"RTN","SROPCEP",163,0)
 Q
"RTN","SROPCEP",164,0)
PMOD ;
"RTN","SROPCEP",165,0)
 N SRM,SRMOD,X
"RTN","SROPCEP",166,0)
 S SRM=0 F  S SRM=$O(^SRO(136,SRTN,1,SRM)) Q:'SRM  S X=$P(^SRO(136,SRTN,1,SRM,0),"^"),SRMOD=$P($$MOD^ICPTMOD(X,"I"),"^",2),^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"MODIFIERS",SRMOD)=""
"RTN","SROPCEP",167,0)
 Q
"RTN","SROPCEP",168,0)
OMOD ;
"RTN","SROPCEP",169,0)
 N SRM,SRMOD,X
"RTN","SROPCEP",170,0)
 S SRM=0 F  S SRM=$O(^SRO(136,SRTN,3,SROTH,1,SRM)) Q:'SRM  S X=$P(^SRO(136,SRTN,3,SROTH,1,SRM,0),"^"),SRMOD=$P($$MOD^ICPTMOD(X,"I"),"^",2),^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"MODIFIERS",SRMOD)=""
"RTN","SROPCEP",171,0)
 Q
"RTN","SROPCEP",172,0)
FM1 M SRDA=DA,SRDP=DP,SRDC=DC,SRDI=DI,SRDL=DL,SRDIE=DIE,SRDG=DG,SRDM=DM,SRDR=DR,SRDH=DH,SRDK=DK,SRD0=D0,SRDDER=DDER,SRDG=DG,SRDIC=DIC,SRDIC1=DIC1,SRDICRRE=DICRREC
"RTN","SROPCEP",173,0)
 M SRDIEDA=DIEDA,SRDIG=DIG,SRDIH=DIH,SRDIIENS=DIIENS,SRDISL=DISL,SRDISYS=DISYS,SRDIU=DIU,SRDIV=DIV,SRDIWT=DIWT,SRDN=DN,SRDQ=DQ,SRDX=DX,SRDY=DY
"RTN","SROPCEP",174,0)
FM2 M DA=SRDA,DP=SRDP,DC=SRDC,DI=SRDI,DL=SRDL,DIE=SRDIE,DG=SRDG,DM=SRDM,DR=SRDR,DH=SRDH,DK=SRDK,D0=SRD0,DDER=SRDDER,DG=SRDG,DIC=SRDIC,DIC1=SRDIC1,DICRREC=SRDICRRE
"RTN","SROPCEP",175,0)
 M DIEDA=SRDIEDA,DIG=SRDIG,DIH=SRDIH,DIIENS=SRDIIENS,DISL=SRDISL,DISYS=SRDISYS,DIU=SRDIU,DIV=SRDIV,DIWT=SRDIWT,DN=SRDN,DQ=SRDQ,DX=SRDX,DY=SRDY
"RTN","SROVER3")
0^8^B45495273^B37536905
"RTN","SROVER3",1,0)
SROVER3 ;BIR/ADM - Case Coding and Verification ;07/26/07
"RTN","SROVER3",2,0)
 ;;3.0;Surgery;**86,88,127,119,152,159,177,183**;24 Jun 93;Build 14
"RTN","SROVER3",3,0)
 ;;
"RTN","SROVER3",4,0)
 ; Reference to CL^SDCO21 supported by DBIA #406
"RTN","SROVER3",5,0)
 ;;
"RTN","SROVER3",6,0)
 S SROVER=1,SRAO(1)=26,SRAO(2)=27,SRAO(3)="",SRAO(4)=$S(SRNON:33,1:34),SRAO(5)=66,SRAO(6)="",SRAO(7)=32,SRAO(8)=32.5,SRMSG="NO Assoc. DX ENTERED"
"RTN","SROVER3",7,0)
ASK W ! K DIR S DIR("A")="Select Information to Edit: ",DIR(0)="FOA",DIR("?",1)="Enter the number corresponding to the information you want to update.  You may"
"RTN","SROVER3",8,0)
 S DIR("?",2)="enter 'ALL' to update all the information displayed on this screen, or a",DIR("?")="range of numbers separated by a ':' to update more than one item." D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1 Q
"RTN","SROVER3",9,0)
 I X="" S SREDIT=1 Q
"RTN","SROVER3",10,0)
 S:$E(X)="a" X="A" I '$D(SRAO(X)),(X'?.N1":".N),($E(X)'="A") D HELP Q:SRSOUT  G ASK
"RTN","SROVER3",11,0)
 I $E(X)="A" S X="1:8"
"RTN","SROVER3",12,0)
 I X?.N1":".N S Y=$E(X),Z=$P(X,":",2) I Y<1!(Z>8)!(Y>Z) D HELP Q:SRSOUT  G ASK
"RTN","SROVER3",13,0)
 D HDR^SROVER2 I X?.N1":".N D RANGE Q
"RTN","SROVER3",14,0)
 S EMILY=X D ONE Q
"RTN","SROVER3",15,0)
 Q
"RTN","SROVER3",16,0)
HELP W !!,"Enter the number corresponding to the information you want to update.  You may",!,"enter 'ALL' to update all the information displayed on this screen, or a"
"RTN","SROVER3",17,0)
 W !,"range of numbers separated by a ':' to update more than one item."
"RTN","SROVER3",18,0)
 Q
"RTN","SROVER3",19,0)
PRESS W ! K DIR S DIR("A")="Press RETURN to continue ",DIR(0)="FOA" D ^DIR K DIR
"RTN","SROVER3",20,0)
 Q
"RTN","SROVER3",21,0)
RANGE ; range of numbers
"RTN","SROVER3",22,0)
 S SHEMP=$P(X,":"),CURLEY=$P(X,":",2) F EMILY=SHEMP:1:CURLEY Q:SRSOUT  W ! D ONE
"RTN","SROVER3",23,0)
 Q
"RTN","SROVER3",24,0)
ONE ; edit one item
"RTN","SROVER3",25,0)
 I EMILY=3 D POTH Q
"RTN","SROVER3",26,0)
 I EMILY=6 D DOTH Q
"RTN","SROVER3",27,0)
 W ! K DR,DIE,DA S DIE=130,DA=SRTN,DR=SRAO(EMILY)_"T" D ^DIE K DR,DIE I $D(Y) S SRSOUT=1
"RTN","SROVER3",28,0)
 I EMILY=4&($$SCEC()) D ASK^SROPCE1 K SRCL
"RTN","SROVER3",29,0)
 I EMILY=2 D CASDX^SROADX
"RTN","SROVER3",30,0)
 Q
"RTN","SROVER3",31,0)
POTH W !,"Other Procedures:",!
"RTN","SROVER3",32,0)
 N SRSHT K SRSEL S CNT=1,OTH=0 F  S OTH=$O(^SRF(SRTN,13,OTH)) Q:'OTH!(SRSOUT)  D
"RTN","SROVER3",33,0)
 .S OTHER=$P(^SRF(SRTN,13,OTH,0),U),X=$P($G(^SRF(SRTN,13,OTH,2)),U),CPT="NOT ENTERED",CPT1=""
"RTN","SROVER3",34,0)
 .I X S CPT1=X,Y=$$CPT^ICPTCOD(X,$P($G(^SRF(SRTN,0)),"^",9)),SRCPT=$P(Y,U,2),SRSHT=$P(Y,U,3),Y=SRCPT,SRDA=OTH D SSOTH^SROCPT S SRCPT=Y,CPT=SRCPT_"  "_SRSHT
"RTN","SROVER3",35,0)
 .W !,CNT_". "_OTHER
"RTN","SROVER3",36,0)
 .W !,?5,"CPT Code: "_CPT
"RTN","SROVER3",37,0)
 .S SRSEL(CNT)=OTH_"^"_OTHER_"^CPT Code: "_CPT_"^"_CPT1
"RTN","SROVER3",38,0)
 .D OTHADXD^SROADX1
"RTN","SROVER3",39,0)
 .S CNT=CNT+1
"RTN","SROVER3",40,0)
 W !,CNT_". Enter NEW Other Procedure",! K DIR S DIR("A")="Enter selection",DIR(0)="NO^1:"_CNT D ^DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1 Q
"RTN","SROVER3",41,0)
 Q:'Y  S SRDA=Y W !! I SRDA<CNT D  G PH
"RTN","SROVER3",42,0)
 .D HDR^SROVER2
"RTN","SROVER3",43,0)
 .W !,"Other Procedures:",!
"RTN","SROVER3",44,0)
 .W !,SRDA,"."
"RTN","SROVER3",45,0)
 .W ?3,$P(SRSEL(SRDA),U,2),!,?5,$P(SRSEL(SRDA),U,3)
"RTN","SROVER3",46,0)
 .S OTH=$P(SRSEL(SRDA),U) K SRDES S CPT1=$P(SRSEL(SRDA),U,4),X=$$CPTD^ICPTCOD(CPT1,"SRDES",,$P($G(^SRF(SRTN,0)),"^",9)) I $O(SRDES(0)) F I=1:1:X W !,?5,SRDES(I)
"RTN","SROVER3",47,0)
 .K DA,DIE,DIR,DR W ! S DA=$P(SRSEL(SRDA),U),DA(1)=SRTN,DIE="^SRF(SRTN,13,",DR=".01;3" D ^DIE D:$D(DA) COTHADX^SROADX K DA,DIE,DR Q:$D(Y)  D PRESS
"RTN","SROVER3",48,0)
 K DIR S DIR("A")="Enter new OTHER PROCEDURE",DIR(0)="130.16,.01" D ^DIR K DIR S SRNEW=Y I $D(DTOUT)!$D(DUOUT)!(Y="") G PH
"RTN","SROVER3",49,0)
 K DD,DO S DIC="^SRF(SRTN,13,",X=SRNEW,DIC(0)="L",DIC("P")=$P(^DD(130,.42,0),U,2) D FILE^DICN K DIC,DD,DO I +Y<0 Q
"RTN","SROVER3",50,0)
 K DA,DIE,DIR,DR S DA=+Y,DA(1)=SRTN,DIE="^SRF(SRTN,13,",DR="3" D ^DIE K DA,DIE,DR Q:$D(Y)  S SRDA=CNT,OTHER=SRNEW D COTHADX^SROADX D PRESS
"RTN","SROVER3",51,0)
PH D HDR^SROVER2 D POTH
"RTN","SROVER3",52,0)
 Q
"RTN","SROVER3",53,0)
DOTH W !,"Other Postop Diagnosis:",!
"RTN","SROVER3",54,0)
 N SCEC,ENVARR S SCEC=$$SCEC()
"RTN","SROVER3",55,0)
 K SRSEL S CNT=1,OTH=0 F  S OTH=$O(^SRF(SRTN,15,OTH)) Q:'OTH!(SRSOUT)  D
"RTN","SROVER3",56,0)
 .S OTHER=$P(^SRF(SRTN,15,OTH,0),U),X=$P($G(^SRF(SRTN,15,OTH,0)),U,3),SRDIAG="NOT ENTERED"
"RTN","SROVER3",57,0)
 .I X S Y=$$ICD^SROICD(SRTN,X),SRNUM=$P(Y,U,2),SRDES=$P(Y,U,4),SRDIAG=SRNUM_"  "_SRDES
"RTN","SROVER3",58,0)
 .W !,CNT_". "_OTHER,!,?5,"ICD"_$$ICD910^SROICD(SRTN)_" Code: "_SRDIAG S SRSEL(CNT)=OTH_"^"_OTHER_"^ICD Code: "_SRDIAG
"RTN","SROVER3",59,0)
 .D:SCEC
"RTN","SROVER3",60,0)
 ..; pwc added 12 for Camp Lejeune SR*3*183
"RTN","SROVER3",61,0)
 ..D GETS^DIQ(130.18,OTH_","_SRTN_",","4:12","E","ENVARR")
"RTN","SROVER3",62,0)
 ..I $D(ENVARR(130.18,OTH_","_SRTN_",",4,"E")) D
"RTN","SROVER3",63,0)
 ...N SRCOLSPN S SRCOLSPN=13 W !
"RTN","SROVER3",64,0)
 ...I $D(SRCL(3)) W ?SRCOLSPN,"SC:",$E(ENVARR(130.18,OTH_","_SRTN_",",4,"E")) S SRCOLSPN=SRCOLSPN+8
"RTN","SROVER3",65,0)
 ...I $D(SRCL(7)) W ?SRCOLSPN,"CV:",$E(ENVARR(130.18,OTH_","_SRTN_",",10,"E")) S SRCOLSPN=SRCOLSPN+8
"RTN","SROVER3",66,0)
 ...I $D(SRCL(1)) W ?SRCOLSPN,"AO:",$E(ENVARR(130.18,OTH_","_SRTN_",",5,"E")) S SRCOLSPN=SRCOLSPN+8
"RTN","SROVER3",67,0)
 ...I $D(SRCL(2)) W ?SRCOLSPN,"IR:",$E(ENVARR(130.18,OTH_","_SRTN_",",6,"E")) S SRCOLSPN=SRCOLSPN+8
"RTN","SROVER3",68,0)
 ...I $D(SRCL(4)) W ?SRCOLSPN,"SWAC:",$E(ENVARR(130.18,OTH_","_SRTN_",",9,"E")) S SRCOLSPN=SRCOLSPN+8
"RTN","SROVER3",69,0)
 ...I $D(SRCL(8)) W ?SRCOLSPN,"SHAD:",$E(ENVARR(130.18,OTH_","_SRTN_",",11,"E")) S SRCOLSPN=SRCOLSPN+8
"RTN","SROVER3",70,0)
 ...I $D(SRCL(5)) W ?SRCOLSPN,"MST:",$E(ENVARR(130.18,OTH_","_SRTN_",",7,"E")) S SRCOLSPN=SRCOLSPN+8
"RTN","SROVER3",71,0)
 ...I $D(SRCL(6)) W ?SRCOLSPN,"H&N:",$E(ENVARR(130.18,OTH_","_SRTN_",",8,"E")) S SRCOLSPN=SRCOLSPN+8
"RTN","SROVER3",72,0)
 ...I $D(SRCL(9)) W ?SRCOLSPN,"CLV:" D  S SRCOLSPN=SRCOLSPN+8       ;pwc Camp Lejeune SR*3*183
"RTN","SROVER3",73,0)
 .... ; display from file 130.18 if available, otherwise lookup answer from surgery file SR*3*183
"RTN","SROVER3",74,0)
 .... W:$E(ENVARR(136.18,OTH_","_SRTN_",",12,"E"))'="" $E(ENVARR(130.18,OTH_","_SRTN_",",12,"E"))
"RTN","SROVER3",75,0)
 .... I $E(ENVARR(136.18,OTH_","_SRTN_",",12,"E"))="" S SRCLVD=$$GET1^DIQ(130,$P(SR(0),"^",1)_",",.027,"","SRERR")  W $E(SRCLVD,1) D
"RTN","SROVER3",76,0)
 .....; file SRCLVD variable back into file 130.18  SR*3*183
"RTN","SROVER3",77,0)
 .....N SRFDA,SRMSG S SRFDA(130.18,OTH_","_SRTN_",",12)=$S(SRCLVD="YES":1,1:0) D FILE^DIE("E","SRFDA","SRMSG")
"RTN","SROVER3",78,0)
 .S CNT=CNT+1
"RTN","SROVER3",79,0)
 W !,CNT_". Enter NEW Other Postop Diagnosis",! K DIR S DIR("A")="Enter selection",DIR(0)="NO^1:"_CNT D ^DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1 Q
"RTN","SROVER3",80,0)
 Q:'Y  S SRDA=Y W !! I SRDA<CNT D  G DH
"RTN","SROVER3",81,0)
 .W ?3,$P(SRSEL(SRDA),U,2),!,?5,$P(SRSEL(SRDA),U,3)
"RTN","SROVER3",82,0)
 .N SRCVET K DA,DIE,DIR S DA=$P(SRSEL(SRDA),U),DA(1)=SRTN,DIE="^SRF(SRTN,15,",DR=".01T;3T;"
"RTN","SROVER3",83,0)
 .S SRCVET=$P($G(^SRF(SRTN,15,DA,2)),"^",7) S SRCVET=$S(SRCVET=0:"NO",1:"YES")
"RTN","SROVER3",84,0)
 .S:$D(SRCL(3)) DR=DR_"4T;" S:$D(SRCL(7)) DR=DR_"10T//"_SRCVET_";" S:$D(SRCL(1)) DR=DR_"5T;" S:$D(SRCL(2)) DR=DR_"6T;" S:$D(SRCL(4)) DR=DR_"9T;"
"RTN","SROVER3",85,0)
 .S:$D(SRCL(5)) DR=DR_"7T;" S:$D(SRCL(6)) DR=DR_"8T;" S:$D(SRCL(8)) DR=DR_"11T;" S:$D(SRCL(9)) DR=DR_"12T;"  ;pwc Camp Lejeune SR*3*183
"RTN","SROVER3",86,0)
 .D ^DIE K DA,DIE,DIR,DR
"RTN","SROVER3",87,0)
 K DIR,SRCL S DIR("A")="Enter new Other Postop Diagnosis",DIR(0)="130.18,.01" D ^DIR K DIR S SRNEW=Y I $D(DTOUT)!$D(DUOUT)!(Y="") G DH
"RTN","SROVER3",88,0)
 S DIR("A")="Planned Other ICD Diagnosis Code",DIR(0)="130.18,3" D ^DIR K DIR S SRCODE=$P(Y,U) I $D(DTOUT)!$D(DUOUT) S SRSOUT=1 Q
"RTN","SROVER3",89,0)
 S:'$D(DA(1)) DA(1)=SRTN
"RTN","SROVER3",90,0)
 S SRCODE=Y K DD,DO S DIC="^SRF(SRTN,15,",X=SRNEW,DIC(0)="L",DIC("DR")="3////"_$P(SRCODE,U),DIC("P")=$P(^DD(130,.74,0),U,2) D FILE^DICN K DA,DD,DIC,DO,DR
"RTN","SROVER3",91,0)
DH D HDR^SROVER2 D DOTH
"RTN","SROVER3",92,0)
 Q
"RTN","SROVER3",93,0)
SCEC() N SRSDATE,DFN,SCEC S SRSDATE=$S($D(SRTN):$P(^SRF(SRTN,0),U,9),1:DT)
"RTN","SROVER3",94,0)
 S DFN=$P(^SRF(SRTN,0),U) D CL^SDCO21(DFN,SRSDATE,,.SRCL)
"RTN","SROVER3",95,0)
 N CLV D SVC^VADPT S CLV=$G(VASV(15)) I CLV,('$G(SRCL(9))) S SRCL(9)=""   ; set CLV array if SD patch is not released yet and veteran is CLV eligible SR*3*183
"RTN","SROVER3",96,0)
 S SCEC=$S($D(SRCL):1,1:0) K VASV(15)
"RTN","SROVER3",97,0)
 Q SCEC
"RTN","SROWL0")
0^14^B13754639^B12998165
"RTN","SROWL0",1,0)
SROWL0 ;B'HAM ISC/MAM - EDIT OR DELETE WAITING LIST ;08 Nov 2018  8:12 AM
"RTN","SROWL0",2,0)
 ;;3.0;Surgery;**58,183**;24 Jun 93;Build 14
"RTN","SROWL0",3,0)
DEL S SRDEL=1
"RTN","SROWL0",4,0)
EDIT S:'$D(SRDEL) SRDEL=0
"RTN","SROWL0",5,0)
 S SRSOUT=0 W @IOF,! K DIC S DIC=2,DIC(0)="QEAMZ",DIC("A")=$S(SRDEL:"Delete ",1:"Edit ")_"which Patient ?  " D ^DIC G:Y<0 END S DFN=+Y,SRSDPT=$P(Y(0),"^")
"RTN","SROWL0",6,0)
LIST W @IOF,!,"Procedures entered on the Waiting List for "_SRSDPT,!!
"RTN","SROWL0",7,0)
 K SRW S (CNT,SRSS)=0 F I=0:0 S SRSS=$O(^SRO(133.8,"AP",DFN,SRSS)) Q:'SRSS  S SROFN=0 F I=0:0 S SROFN=$O(^SRO(133.8,"AP",DFN,SRSS,SROFN)) Q:'SROFN  D ARRAY
"RTN","SROWL0",8,0)
 I '$D(SRW(1)) W !!,"There are no entries on the Waiting List for "_SRSDPT_".",!! G END
"RTN","SROWL0",9,0)
 I '$D(SRW(2)) S SRW=1 G DIE
"RTN","SROWL0",10,0)
 W !!!,"Select Number: " R X:DTIME I "^"[X S SRSOUT=1 G END
"RTN","SROWL0",11,0)
 I '$D(SRW(X)) W !!,"Select the number corresponding to the entry you want to "_$S(SRDEL:"delete",1:"edit")_".  Enter '^'",!,"to quit this option.",!!,"Press RETURN to continue  " R X:DTIME G LIST
"RTN","SROWL0",12,0)
 S SRW=X
"RTN","SROWL0",13,0)
DIE I SRDEL G DIK
"RTN","SROWL0",14,0)
 D NOW^%DTC S SRNOW=$E(%,1,12),SRSS=$P(SRW(SRW),"^"),SROFN=$P(SRW(SRW),"^",2)
"RTN","SROWL0",15,0)
 K DR,DIE,DA S DA(1)=SRSS,DA=SROFN,DIE="^SRO(133.8,"_DA(1)_",1,",DR="1T;4T;5T;6T;W !;3T",DR(2,133.8013)=".01T;1T;2T;3T;4T;5T" D ^DIE K DR,DIE,DA D WL^SROPCE1
"RTN","SROWL0",16,0)
 G END
"RTN","SROWL0",17,0)
DIK ; delete entry
"RTN","SROWL0",18,0)
 W !!,"Are you sure that you want to delete this entry ?  YES//  " R SRYN:DTIME I '$T!(SRYN["^") S SRSOUT=1 G END
"RTN","SROWL0",19,0)
 S SRYN=$E(SRYN) S:SRYN="" SRYN="Y" I "YyNn"'[SRYN W !!,"Enter 'NO' if you have made a mistake and do not want to remove this",!,"procedure from the list, or 'YES' to delete the entry." G DIE
"RTN","SROWL0",20,0)
 I "Yy"'[SRYN W !!,"No action taken." G END
"RTN","SROWL0",21,0)
 S DA(1)=$P(SRW(SRW),"^"),DA=$P(SRW(SRW),"^",2),DIK="^SRO(133.8,"_DA(1)_",1," D ^DIK
"RTN","SROWL0",22,0)
 W !!,SRSDPT_" has been removed from the Waiting List."
"RTN","SROWL0",23,0)
END I 'SRSOUT W !!,"Press RETURN to continue  " R X:DTIME
"RTN","SROWL0",24,0)
 D ^SRSKILL W @IOF
"RTN","SROWL0",25,0)
 Q
"RTN","SROWL0",26,0)
ARRAY ; set array containing waiting list info
"RTN","SROWL0",27,0)
 S CNT=CNT+1,SRSNM=$P(^SRO(133.8,SRSS,0),"^"),SRSNM=$P(^SRO(137.45,SRSNM,0),"^")
"RTN","SROWL0",28,0)
 S SROPER=$P(^SRO(133.8,SRSS,1,SROFN,0),"^",2),SRDT=$P(^(0),"^",3),SROPDT=$P(^(0),"^",5),Y=SRDT D D^DIQ S SRDT=$E(Y,1,12) I SROPDT S Y=SROPDT D D^DIQ S SROPDT=$E(Y,1,12)
"RTN","SROWL0",29,0)
 K SROP,MM,MMM S:$L(SROPER)<36 SROP(1)=SROPER I $L(SROPER)>35 S SROPER=SROPER_"  " S SROPER=SROPER_"  " F M=1:1 D LOOP Q:MMM=""
"RTN","SROWL0",30,0)
 S SRW(CNT)=SRSS_"^"_SROFN_"^"_SRSNM_"^"_SRDT_"^"_SROPER_"^"_SROPDT_"^"_$P(^SRO(133.8,SRSS,1,SROFN,0),"^",17,25)  ;SR*3.0*183 added 17,25 Camp Lejeune
"RTN","SROWL0",31,0)
 W !,CNT_". "_SRSNM,?40,"Date Entered on List:",?66,SRDT,!,?3,SROP(1),?40,"Tentative Operation Date: ",?66,SROPDT
"RTN","SROWL0",32,0)
 I $D(SROP(2)) W !,?3,SROP(2)
"RTN","SROWL0",33,0)
 W !
"RTN","SROWL0",34,0)
 Q
"RTN","SROWL0",35,0)
LOOP ; break procedure if greater than 36 characters
"RTN","SROWL0",36,0)
 S SROP(M)="" F LOOP=1:1 S MM=$P(SROPER," "),MMM=$P(SROPER," ",2,200) Q:MMM=""  Q:$L(SROP(M))+$L(MM)'<36  S SROP(M)=SROP(M)_MM_" ",SROPER=MMM
"RTN","SROWL0",37,0)
 Q
"RTN","SRSRQST")
0^15^B38890100^B38397734
"RTN","SRSRQST",1,0)
SRSRQST ;BIR/MAM,ADM - MAKE OPERATION REQUESTS ;11/01/01  9:40 AM
"RTN","SRSRQST",2,0)
 ;;3.0;Surgery;**3,58,67,88,103,105,100,144,175,177,182,184,183**;24 Jun 93;Build 14
"RTN","SRSRQST",3,0)
MUST S SRLINE="" F I=1:1:80 S SRLINE=SRLINE_"="
"RTN","SRSRQST",4,0)
 W @IOF W:$D(SRCC) !,?29,$S(SRSCON=1:"FIRST",1:"SECOND")_" CONCURRENT CASE" W !,?20,"OPERATION REQUEST: REQUIRED INFORMATION",!!,SRNM_" ("_SRSSN_")",?65,SREQDT,!,SRLINE,!
"RTN","SRSRQST",5,0)
SURG ; surgeon
"RTN","SRSRQST",6,0)
 K DIR S DIR(0)="130,.14",DIR("A")="Primary Surgeon" D ^DIR K DIR I $D(DTOUT)!(X="^") S SRSOUT=1 G END
"RTN","SRSRQST",7,0)
 I Y=""!(X["^") W !!,"To make an operation request, a Surgeon MUST be selected.  Enter '^' to exit.",! G SURG
"RTN","SRSRQST",8,0)
 S SRSDOC=+Y
"RTN","SRSRQST",9,0)
CASE K DA,DIC,DD,DO,DINUM,SRTN S X=SRSDPT,DIC="^SRF(",DIC(0)="L",DLAYGO=130 D FILE^DICN K DD,DO,DIC,DLAYGO S SRTN=+Y
"RTN","SRSRQST",10,0)
 N SRLCK S SRLCK=$$LOCK^SROUTL(SRTN)
"RTN","SRSRQST",11,0)
 S ^SRF(SRTN,8)=SRSITE("DIV"),^SRF(SRTN,"OP")=""
"RTN","SRSRQST",12,0)
 D NOW^%DTC S SREQDAY=+$E(%,1,12),SRNOCON=1 K DR,DIE
"RTN","SRSRQST",13,0)
 S DA=SRTN,DIE=130,DR="36////1;Q;.09////"_SRSDATE_";.14////"_SRSDOC_";1.098////"_+SREQDAY_";1.099////"_DUZ_";Q"_";612////"_SRSDATE_";616////"_SRSDATE_";613////"_SREQDAY D ^DIE K DR
"RTN","SRSRQST",14,0)
ASURG ; attending surgeon
"RTN","SRSRQST",15,0)
 K DIR S DIR(0)="130,.164",DIR("A")="Attending Surgeon" D ^DIR K DIR I $D(DTOUT)!(X="^") S SRSOUT=1 G DEL
"RTN","SRSRQST",16,0)
 I Y=""!(X["^") W !!,"To make an operation request, Attending Surgeon MUST be selected.  Enter '^' to exit.",! G ASURG
"RTN","SRSRQST",17,0)
 S SRATTND=+Y
"RTN","SRSRQST",18,0)
SPEC ; surgical specialty
"RTN","SRSRQST",19,0)
 I SRWL W !,"Surgical Specialty: "_$P(^SRO(137.45,SRSS,0),"^") G OP
"RTN","SRSRQST",20,0)
 K DIR S DIR(0)="130,.04",DIR("A")="Surgical Specialty" D ^DIR K DIR I $D(DTOUT)!(X="^") S SRSOUT=1 G DEL
"RTN","SRSRQST",21,0)
 I Y=""!(X["^") W !!,"To make an operation request, a Surgical Specialty MUST be selected.  Enter '^'",!,"to exit.",! G SPEC
"RTN","SRSRQST",22,0)
 S SRSS=+Y
"RTN","SRSRQST",23,0)
OP ; principal operative procedure
"RTN","SRSRQST",24,0)
 I SRWL W !,"Principal Operative Procedure: "_SRSOP G OPD
"RTN","SRSRQST",25,0)
 K DIR S DIR(0)="130,26",DIR("A")="Principal Operative Procedure" D ^DIR K DIR I $D(DTOUT)!(X="^") S SRSOUT=1 G DEL
"RTN","SRSRQST",26,0)
 I X["^" W !!,"Principal procedure must not contain an up-arrow (^).",! G OP
"RTN","SRSRQST",27,0)
 S SRSOP=Y
"RTN","SRSRQST",28,0)
OPD ; Principal Preoperative Diagnosis
"RTN","SRSRQST",29,0)
 K DIR S DIR(0)="130,32",DIR("A")="Principal Preoperative Diagnosis" D ^DIR K DIR I $D(DTOUT)!(X="^") S SRSOUT=1 G DEL
"RTN","SRSRQST",30,0)
 I Y=""!(X["^") W !,"Principal Preoperative Diagnosis MUST be entered",!,"before proceeding with this request. Enter '^' to exit.",! G OPD
"RTN","SRSRQST",31,0)
 I X[";" W !!,"The Principal Preoperative Diagnosis cannot contain a semicolon (;).",!,"Please re-enter the Diagnosis, using commas in place of the semicolons." G OPD
"RTN","SRSRQST",32,0)
 S SRSOPD=Y
"RTN","SRSRQST",33,0)
 W !!,"The information entered into the Principal Preoperative Diagnosis field",!,"has been transferred into the Indications for Operation field.",!,"The Indications for Operation field can be updated later if necessary.",!
"RTN","SRSRQST",34,0)
 W !!,"Press RETURN to continue  " R X:DTIME
"RTN","SRSRQST",35,0)
 ;
"RTN","SRSRQST",36,0)
LP ; LATERALITY OF PROCEDURE
"RTN","SRSRQST",37,0)
 K DIR W ! S DIR(0)="130,638",DIR("A")="Laterality Of Procedure" D ^DIR K DIR I $D(DTOUT)!(X="^") S SRSOUT=1 G DEL
"RTN","SRSRQST",38,0)
 I Y=""!(X["^") W !!,"To make an operation request, Laterality Of Procedure MUST be entered.   Enter '^' to exit.",! G LP
"RTN","SRSRQST",39,0)
 S SRLP=Y
"RTN","SRSRQST",40,0)
PAS ; Planned Admission Status
"RTN","SRSRQST",41,0)
 K DIR S DIR(0)="130,.013",DIR("A")="Planned Admission Status" D ^DIR K DIR I $D(DTOUT)!(X="^") S SRSOUT=1 G DEL
"RTN","SRSRQST",42,0)
 I Y=""!(X["^") W !!,"To make an operation request, Planned Admission Status field MUST be entered. Enter '^' to exit.",! G PAS
"RTN","SRSRQST",43,0)
 S SRPAS=Y
"RTN","SRSRQST",44,0)
PCPT ; Planned Principal Procedure Code (CPT)
"RTN","SRSRQST",45,0)
 K DIR S DIR(0)="130,27",DIR("A")="Planned Principal Procedure Code" D ^DIR K DIR I $D(DTOUT)!(X="^") S SRSOUT=1 G DEL
"RTN","SRSRQST",46,0)
 I Y=""!(X["^") W !!,"To make an operation request, Planned Principal Procedure Code field MUST be entered. Enter '^' to exit.",! G PCPT
"RTN","SRSRQST",47,0)
 S SRCPT=$P(Y,"^")
"RTN","SRSRQST",48,0)
 ;
"RTN","SRSRQST",49,0)
UPDATE S DA=SRTN,DIE=130,DR="26////"_SRSOP_";68////"_SRSOP_";.04////"_SRSS_";.164////"_SRATTND_";32////"_SRSOPD_";638////"_SRLP_";.013////"_SRPAS_";.011////"_SRPAS_";27////"_SRCPT D ^DIE
"RTN","SRSRQST",50,0)
 ; PWC Added SRCL(25) for Camp Lejeune SR*3*183
"RTN","SRSRQST",51,0)
 I SRWL K DA,DIE,DR S DA=SRTN,DIE=130,DR=".016////"_SRCL(16)_";.017////"_SRCL(17)_";.018////"_SRCL(18)_";.019////"_SRCL(19)_";.0155////"_SRCL(20)_";.022////"_SRCL(21)_";.023////"_SRCL(22)_";.027////"_$G(SRCL(25)) D ^DIE
"RTN","SRSRQST",52,0)
 D SPIN
"RTN","SRSRQST",53,0)
 K DR,DA S DR="[SRO-NOCOMP]",DA=SRTN,DIE=130 D ^DIE K DR
"RTN","SRSRQST",54,0)
 S ^SRF(SRTN,8)=SRSITE("DIV") D ^SROXRET K SRNOCON
"RTN","SRSRQST",55,0)
OTHER ; other required fields
"RTN","SRSRQST",56,0)
 S SRFLD=0 F  S SRFLD=$O(^SRO(133,SRSITE,4,SRFLD)) Q:'SRFLD!(SRSOUT)  D OTHDIR Q:SRSOUT
"RTN","SRSRQST",57,0)
 I SRSOUT G DEL
"RTN","SRSRQST",58,0)
 S SRSOPD(1)=SRSOPD D WP^DIE(130,SRTN_",",55,"A","SRSOPD")
"RTN","SRSRQST",59,0)
 I $D(SRCC),SRSCON=2 S DIE=130,DR="35////"_SRSCON(1),DA=SRTN D ^DIE K DR S DR="35////"_SRTN,DA=SRSCON(1),DIE=130 D ^DIE K DR,DA
"RTN","SRSRQST",60,0)
 D ^SROERR I $D(SRDUOUT) S SRSOUT=1 Q
"RTN","SRSRQST",61,0)
 I '$D(SRCC) D ^SRSRQST1
"RTN","SRSRQST",62,0)
 D:$G(SRLCK) UNLOCK^SROUTL(SRTN)
"RTN","SRSRQST",63,0)
 Q
"RTN","SRSRQST",64,0)
DEL I SRSOUT S DA=SRTN,DIK="^SRF(" D ^DIK
"RTN","SRSRQST",65,0)
END D:$G(SRLCK) UNLOCK^SROUTL(SRTN)
"RTN","SRSRQST",66,0)
 I SRSOUT W !!,"No request has been entered.",! S:'$D(SRCC) SRSOUT=0
"RTN","SRSRQST",67,0)
 Q
"RTN","SRSRQST",68,0)
CON ; request concurrent case
"RTN","SRSRQST",69,0)
 D MUST Q:SRSOUT  S SRSCON(SRSCON,"DOC")=$P(^VA(200,SRSDOC,0),"^"),SRSCON(SRSCON,"SS")=$P(^SRO(137.45,SRSS,0),"^"),SRSCON(SRSCON,"OP")=SRSOP,SRSCON(SRSCON)=SRTN K DA
"RTN","SRSRQST",70,0)
 Q
"RTN","SRSRQST",71,0)
OTHDIR ; call to reader for site specific required fields
"RTN","SRSRQST",72,0)
 ;JAS - 08/05/14 - SR*3*177 - Modified this section for ICD-10
"RTN","SRSRQST",73,0)
 K DIR,SREQ,SRY S FLD=$P(^SRO(133,SRSITE,4,SRFLD,0),"^") D FIELD^DID(130,FLD,"","TITLE","SRY") S DIR(0)="130,"_FLD,DIR("A")=SRY("TITLE") D DIRYN I $D(DTOUT)!($G(X)="^") S SRSOUT=1 Q
"RTN","SRSRQST",74,0)
 I "^32.5^66^253^286^343^344^392^489^"[("^"_FLD_"^") I $G(X)="@"!($G(X)="") S X="^"
"RTN","SRSRQST",75,0)
 I $G(Y)=""!(X["^") W !!,"It is mandatory that you provide this information before proceeding with this",!,"request.",! D ASK Q:SRSOUT  G OTHDIR
"RTN","SRSRQST",76,0)
 S SREQ(130,SRTN_",",FLD)=$P(Y,"^") D FILE^DIE("","SREQ","^TMP(""SR"",$J)")
"RTN","SRSRQST",77,0)
 Q
"RTN","SRSRQST",78,0)
DIRYN ; call ^DIR if not FILE 80 or ICD-9 FILE 80 (added for SR*3.0*177)
"RTN","SRSRQST",79,0)
 I "^32.5^66^253^286^343^344^392^489^"[("^"_FLD_"^") D  Q
"RTN","SRSRQST",80,0)
 . S SRPRMT=DIR("A")_" ",SRDEF=$$GET1^DIQ(130,SRTN,FLD)
"RTN","SRSRQST",81,0)
 . D ICDSRCH^SROICD
"RTN","SRSRQST",82,0)
 D ^DIR
"RTN","SRSRQST",83,0)
 Q 
"RTN","SRSRQST",84,0)
ASK K DIR S DIR(0)="Y",DIR("A")="Do you want to continue with this request ",DIR("B")="YES"
"RTN","SRSRQST",85,0)
 S DIR("?")="Enter RETURN to continue with this request, or 'NO' to discontinue this request." D ^DIR S:'Y SRSOUT=1
"RTN","SRSRQST",86,0)
 Q
"RTN","SRSRQST",87,0)
SPIN ; spinal level free-text
"RTN","SRSRQST",88,0)
 I '$$SPIN^SRTOVRF(SRCPT) Q
"RTN","SRSRQST",89,0)
 N SL
"RTN","SRSRQST",90,0)
 K DIR S DIR(0)="130,136",DIR("A")="Spinal Level Comment" D ^DIR K DIR
"RTN","SRSRQST",91,0)
 S SL=$P(Y,"^") I Y=""!$D(DTOUT)!$D(DUOUT) S SL=""
"RTN","SRSRQST",92,0)
 S $P(^SRF(SRTN,1.1),"^",4)=SL
"RTN","SRSRQST",93,0)
 Q
"RTN","SRSWREQ")
0^13^B11627612^B11509762
"RTN","SRSWREQ",1,0)
SRSWREQ ;BIR/MAM - REQUEST FROM WAITING LIST ;07 Nov 2018  7:11 AM
"RTN","SRSWREQ",2,0)
 ;;3.0;Surgery;**58,77,105,146,183**;24 Jun 93;Build 14
"RTN","SRSWREQ",3,0)
 S SRWL=1,SRSOUT=0 I $D(ORVP) S (DFN,SRSDPT)=+ORVP G DEAD
"RTN","SRSWREQ",4,0)
 W @IOF,! K DIC S DIC=2,DIC(0)="QEAMZ",DIC("A")="Make a request from the waiting list for which patient ?  " D ^DIC K DIC I Y<0 S SRSOUT=1 G END
"RTN","SRSWREQ",5,0)
 S (DFN,SRSDPT)=+Y
"RTN","SRSWREQ",6,0)
DEAD D DEM^VADPT S SRNM=VADM(1),SRSSN=VA("PID")
"RTN","SRSWREQ",7,0)
 I $D(^DPT(DFN,.35)),$P(^(.35),"^")'="" S Y=$E($P(^(.35),"^"),1,7) D D^DIQ W !!,"The records show that "_SRNM_" died on "_Y_".",! G END
"RTN","SRSWREQ",8,0)
 I '$O(^SRO(133.8,"AP",DFN,0)) W !!,"There are no entries on the Waiting List for "_SRNM_"." G END
"RTN","SRSWREQ",9,0)
LIST W @IOF,!,"Procedures Entered on the Waiting List for "_SRNM_": ",!! K SRW S (CNT,SRSS)=0
"RTN","SRSWREQ",10,0)
 F  S SRSS=$O(^SRO(133.8,"AP",DFN,SRSS)) Q:'SRSS  S SROFN=0 F  S SROFN=$O(^SRO(133.8,"AP",DFN,SRSS,SROFN)) Q:'SROFN  D ARRAY
"RTN","SRSWREQ",11,0)
 I '$D(SRW(2)) S SRW=1 D OK G:"Yy"[SRYN REQ S SRSOUT=1 G END
"RTN","SRSWREQ",12,0)
 W !!!,"Select Number: " R SRW:DTIME I '$T!("^"[SRW) S SRSOUT=1 G END
"RTN","SRSWREQ",13,0)
 I '$D(SRW(SRW)) W !!,"Select the number corresponding to the entry for which the request will",!,"be made.",!!,"Press RETURN to continue  " R X:DTIME G LIST
"RTN","SRSWREQ",14,0)
REQ S SRSOTH=0
"RTN","SRSWREQ",15,0)
 D LFTOVR^SRSREQUT I SRSOTH S SRSOUT=1 G END
"RTN","SRSWREQ",16,0)
DATE W ! K %DT S %DT="AEFX",%DT("A")="Make a request for which Date ?  " D ^%DT I Y<0 S SRSOUT=1 G END
"RTN","SRSWREQ",17,0)
 S SRSDATE=+Y,SRSST=0 I SRSDATE<DT W !!,"Requests cannot be made for past dates.",!!,"Press RETURN to continue  " G DATE
"RTN","SRSWREQ",18,0)
 D D^DIQ S SREQDT=Y
"RTN","SRSWREQ",19,0)
 K SRLATE D LATE^SRSREQ I $D(SRLATE) G DATE
"RTN","SRSWREQ",20,0)
 ;pwc Added 15 to set SRCL(25) for Camp Lejeune SR*3*183
"RTN","SRSWREQ",21,0)
 S SRSS=$P(SRW(SRW),"^"),SRSOP=$P(SRW(SRW),"^",5) F SRI=6:1:12,15 S SRCL(SRI+10)=$P(SRW(SRW),"^",SRI)
"RTN","SRSWREQ",22,0)
 K DIR I $D(ORNP) S DIR("B")=$P(^VA(200,ORNP,0),"^")
"RTN","SRSWREQ",23,0)
 S ST="REQUEST"
"RTN","SRSWREQ",24,0)
 D ^SRSRQST
"RTN","SRSWREQ",25,0)
END I 'SRSOUT W ! K DIR S DIR(0)="FOA",DIR("A")="Press RETURN to continue: " D ^DIR
"RTN","SRSWREQ",26,0)
 K SRTN D ^SRSKILL W @IOF
"RTN","SRSWREQ",27,0)
 Q
"RTN","SRSWREQ",28,0)
ARRAY ; set array for waiting list info
"RTN","SRSWREQ",29,0)
 S CNT=CNT+1,SRSER=$P(^SRO(133.8,SRSS,0),"^"),SRSERV=$P(^SRO(137.45,SRSER,0),"^")
"RTN","SRSWREQ",30,0)
 ;CLT SR*3.0*183 added piece 25 for Camp Lejeune
"RTN","SRSWREQ",31,0)
 S SROPER=$P(^SRO(133.8,SRSS,1,SROFN,0),"^",2),Y=$P(^(0),"^",3) D D^DIQ S SRDT=$E(Y,1,12),SRW(CNT)=SRSER_"^"_SROFN_"^"_SRSERV_"^"_SRDT_"^"_SROPER_"^"_$P(^SRO(133.8,SRSS,1,SROFN,0),"^",16,25)
"RTN","SRSWREQ",32,0)
 W !,CNT_". "_SRSERV,?40,"Date Entered on List: "_SRDT,!,?3,SROPER,!
"RTN","SRSWREQ",33,0)
 Q
"RTN","SRSWREQ",34,0)
OK W !!,"Is this the correct procedure ?  YES//  " R SRYN:DTIME I '$T!(SRYN["^") S SRYN="N" Q
"RTN","SRSWREQ",35,0)
 S SRYN=$E(SRYN) S:SRYN="" SRYN="Y" I "YyNn"'[SRYN W !!,"Enter RETURN if this is the procedure that you would like to make into a",!,"request.  Otherwise, enter 'NO'." G OK
"RTN","SRSWREQ",36,0)
 Q
"UP",130,130.18,-1)
130^15
"UP",130,130.18,0)
130.18
"UP",133.8,133.801,-1)
133.8^1
"UP",133.8,133.801,0)
133.801
"UP",136,136.04,-1)
136^4
"UP",136,136.04,0)
136.04
"VER")
8.0^22.2
"^DD",130,130,.027,0)
CAMP LEJEUNE^S^1:YES;0:NO;^0;27^Q
"^DD",130,130,.027,.1)
Treatment related to Camp Lejeune Exposure (Y/N)
"^DD",130,130,.027,1,0)
^.1^^0
"^DD",130,130,.027,3)
If this treatment was related to Camp Lejeune exposure enter 'YES'.
"^DD",130,130,.027,21,0)
^^12^12^3180803^
"^DD",130,130,.027,21,1,0)
If the patient's diagnosis is for one or more of the 15 Camp Lejeune
"^DD",130,130,.027,21,2,0)
conditions or any secondary condition related to one of these 15 Camp 
"^DD",130,130,.027,21,3,0)
Lejeune conditions, enter 'YES' or 'Y'.  Otherwise answer 'NO' or 'N'.
"^DD",130,130,.027,21,4,0)
 
"^DD",130,130,.027,21,5,0)
        1.Esophageal cancer                    9.Renal toxicity
"^DD",130,130,.027,21,6,0)
        2.Lung cancer                         10.Hepatic steatosis
"^DD",130,130,.027,21,7,0)
        3.Breast cancer                       11.Female infertility
"^DD",130,130,.027,21,8,0)
        4.Bladder cancer                      12.Miscarriage
"^DD",130,130,.027,21,9,0)
        5.Kidney cancer                       13.Scleroderma
"^DD",130,130,.027,21,10,0)
        6.Leukemia                            14.Neurobehavioral effects
"^DD",130,130,.027,21,11,0)
        7.Multiple myeloma                    15.Non-Hodgkin's lymphoma
"^DD",130,130,.027,21,12,0)
        8.Myelodysplastic syndromes
"^DD",130,130,.027,"DT")
3180803
"^DD",130,130.18,12,0)
CAMP LEJEUNE^S^1:YES;0:NO;^2;9^Q
"^DD",130,130.18,12,.1)
Treatment related to Camp Lejeune Exposure (Y/N)
"^DD",130,130.18,12,3)
If this case is treating a Camp Lejeune exposure problem, enter YES.
"^DD",130,130.18,12,5,1,0)
130.18^.01^10
"^DD",130,130.18,12,21,0)
^.001^3^3^3181210^^^^
"^DD",130,130.18,12,21,1,0)
This field will be used to indicate if this surgery or non-OR procedure
"^DD",130,130.18,12,21,2,0)
is treating a VA patient for a problem that is related to Camp Lejeune
"^DD",130,130.18,12,21,3,0)
Exposure.
"^DD",130,130.18,12,23,0)
^.001^1^1^3180814^^^
"^DD",130,130.18,12,23,1,0)
This information may be passed to the VISIT file (#9000010) for use by PCE.
"^DD",130,130.18,12,"DT")
3181210
"^DD",133.8,133.801,25,0)
CAMP LEJEUNE^S^1:YES;0:NO;^0;25^Q
"^DD",133.8,133.801,25,3)
If treatment is for a Camp Lejeune condition enter 'YES'.
"^DD",133.8,133.801,25,21,0)
14^^14^14^3181019^
"^DD",133.8,133.801,25,21,1,0)
If the patient's diagnosis is for one or more
"^DD",133.8,133.801,25,21,2,0)
of the 15 Camp Lejeune conditions or any
"^DD",133.8,133.801,25,21,3,0)
secondary condition related to one of these 15
"^DD",133.8,133.801,25,21,4,0)
Camp Lejeune conditions, enter 'YES' or 'Y'. 
"^DD",133.8,133.801,25,21,5,0)
Otherwise answer 'NO' or 'N'.  
"^DD",133.8,133.801,25,21,6,0)
                                 
"^DD",133.8,133.801,25,21,7,0)
      1.Esophageal cancer     9.Renal toxicity 
"^DD",133.8,133.801,25,21,8,0)
      2.Lung cancer          10.Hepatic steatosis 
"^DD",133.8,133.801,25,21,9,0)
      3.Breast cancer        11.Female infertility 
"^DD",133.8,133.801,25,21,10,0)
      4.Bladder cancer       12.Miscarriage 
"^DD",133.8,133.801,25,21,11,0)
      5.Kidney cancer        13.Scleroderma 
"^DD",133.8,133.801,25,21,12,0)
      6.Leukemia             14.Neurobehavioral effects 
"^DD",133.8,133.801,25,21,13,0)
      7.Multiple myeloma     15.Non-Hodgkin's lymphoma 
"^DD",133.8,133.801,25,21,14,0)
      8.Myelodysplastic syndromes 
"^DD",133.8,133.801,25,"DT")
3181019
"^DD",136,136,.12,0)
CAMP LEJEUNE^S^1:YES;0:NO;^0;12^Q
"^DD",136,136,.12,.1)
Treatment related to Camp Lejeune Exposure (Y/N)
"^DD",136,136,.12,3)
If this treatment was related to Camp Lejeune exposure enter 'YES'.
"^DD",136,136,.12,21,0)
^^12^12^3180807^
"^DD",136,136,.12,21,1,0)
If the patient's diagnosis is for one or more of the 15 Camp Lejeune
"^DD",136,136,.12,21,2,0)
conditions or any secondary condition related to one of these 15 Camp 
"^DD",136,136,.12,21,3,0)
Lejeune conditions, enter 'YES' or 'Y'.  Otherwise answer 'NO' or 'N'.
"^DD",136,136,.12,21,4,0)
         
"^DD",136,136,.12,21,5,0)
     1.Esophageal cancer                    9.Renal toxicity
"^DD",136,136,.12,21,6,0)
     2.Lung cancer                         10.Hepatic steatosis
"^DD",136,136,.12,21,7,0)
     3.Breast cancer                       11.Female infertility
"^DD",136,136,.12,21,8,0)
     4.Bladder cancer                      12.Miscarriage
"^DD",136,136,.12,21,9,0)
     5.Kidney cancer                       13.Scleroderma
"^DD",136,136,.12,21,10,0)
     6.Leukemia                            14.Neurobehavioral effects
"^DD",136,136,.12,21,11,0)
     7.Multiple myeloma                    15.Non-Hodgkin's lymphoma
"^DD",136,136,.12,21,12,0)
     8.Myelodysplastic syndromes
"^DD",136,136,.12,"DT")
3180807
"^DD",136,136.04,.1,0)
CAMP LEJEUNE^S^1:YES;0:NO;^0;10^Q
"^DD",136,136.04,.1,.1)
Treatment related to Camp Lejeune Exposure (Y/N)
"^DD",136,136.04,.1,3)
If this treatment was related to Camp Lejeune exposure enter 'YES'.
"^DD",136,136.04,.1,21,0)
^^12^12^3180807^
"^DD",136,136.04,.1,21,1,0)
If the patient's diagnosis is for one or more of the 15 Camp Lejeune
"^DD",136,136.04,.1,21,2,0)
conditions or any secondary condition related to one of these 15 Camp 
"^DD",136,136.04,.1,21,3,0)
Lejeune conditions, enter 'YES' or 'Y'.  Otherwise answer 'NO' or 'N'.
"^DD",136,136.04,.1,21,4,0)
         
"^DD",136,136.04,.1,21,5,0)
     1.Esophageal cancer                    9.Renal toxicity
"^DD",136,136.04,.1,21,6,0)
     2.Lung cancer                         10.Hepatic steatosis
"^DD",136,136.04,.1,21,7,0)
     3.Breast cancer                       11.Female infertility
"^DD",136,136.04,.1,21,8,0)
     4.Bladder cancer                      12.Miscarriage
"^DD",136,136.04,.1,21,9,0)
     5.Kidney cancer                       13.Scleroderma
"^DD",136,136.04,.1,21,10,0)
     6.Leukemia                            14.Neurobehavioral effects
"^DD",136,136.04,.1,21,11,0)
     7.Multiple myeloma                    15.Non-Hodgkin's lymphoma
"^DD",136,136.04,.1,21,12,0)
     8.Myelodysplastic syndromes
"^DD",136,136.04,.1,"DT")
3180807
"BLD",11135,6)
3^
$END KID SR*3.0*183

