source: WorldVistAEHR/trunk/r/SURGERY-SR/SROCCAT.m@ 700

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

initial load of WorldVistAEHR

File size: 3.9 KB
Line 
1SROCCAT ;BIR/MAM - PERIOPERATIVE OCCURRENCE UPDATE (Y/N) FIELDS ;01/23/07
2 ;;3.0; Surgery ;**38,47,95,138,153,160**;24 Jun 93;Build 7
3 S ZTDTH=$H,ZTIO="",ZTRTN="EN^SROCCAT",ZTSAVE("SRTN")="",ZTDESC="Update Perioperative Occurrences for Individual Patient" D ^%ZTLOAD
4 Q
5EN ; entry when queued
6 K SRCOMPS S (CNT,CMP)=0 F S CMP=$O(^SRF(SRTN,10,CMP)) Q:'CMP S COMP=$P(^SRF(SRTN,10,CMP,0),"^",2) I COMP S CNT=CNT+1,SRCOMPS(CNT)=COMP_"^"_$P(^(0),"^",3)
7 S CMP=0 F S CMP=$O(^SRF(SRTN,16,CMP)) Q:'CMP S COMP=$P(^SRF(SRTN,16,CMP,0),"^",2) I COMP S SRDATE="" D
8 .S SRDATE=$E($P(^SRF(SRTN,16,CMP,0),"^",7),1,7) I SRDATE S X1=$E($P(^SRF(SRTN,0),"^",9),1,7),X2=30 D C^%DTC I SRDATE>X Q
9 .S CNT=CNT+1,SRCOMPS(CNT)=COMP_"^"_$P(^SRF(SRTN,16,CMP,0),"^",3)
10 K DR,DIE,DA S DA=SRTN,DIE=130,DR="[SRO-NOCOMP]" D ^DIE K DR,DA
11 I '$D(SRCOMPS(1)) S ZTREQ="@" Q
12 S CNT=0 F S CNT=$O(SRCOMPS(CNT)) Q:'CNT S COMPL=$P(SRCOMPS(CNT),"^") D UPDATE
13 S ZTREQ="@"
14 Q
15UPDATE ; update Y/N questions
16 I COMPL=1 K DA,DR,DIE S DA=SRTN,DIE=130,DR="403////Y;248////Y" D ^DIE K DR,DA,DIE Q
17 I COMPL=2 K DA,DR,DIE S DA=SRTN,DIE=130,DR="403////Y;249////Y" D ^DIE K DR,DA,DIE Q
18 I COMPL=3 K DA,DR,DIE S DA=SRTN,DIE=130,DR="322////Y;250////Y" D ^DIE K DR,DA,DIE Q
19 I COMPL=4 K DA,DR,DIE S DA=SRTN,DIE=130,DR="318////Y;251////Y" D ^DIE K DR,DA,DIE Q
20 I COMPL=5 K DA,DR,DIE S DA=SRTN,DIE=130,DR="318////Y;252///Y" D ^DIE K DR,DA,DIE Q
21 I COMPL=6 K DA,DR,DIE S DA=SRTN,DIE=130,DR="318////Y;285///Y" D ^DIE K DR,DA,DIE Q
22 I COMPL=7 K DA,DR,DIE S DA=SRTN,DIE=130,DR="318////Y;412///Y" D ^DIE K DR,DA,DIE Q
23 I COMPL=8 K DA,DR,DIE S DA=SRTN,DIE=130,DR="319////Y;409///Y" D ^DIE K DR,DA,DIE Q
24 I COMPL=9 K DA,DR,DIE S DA=SRTN,DIE=130,DR="319////Y;254///Y" D ^DIE K DR,DA,DIE Q
25 I COMPL=10 K DA,DR,DIE S DA=SRTN,DIE=130,DR="319////Y;255///Y" D ^DIE K DR,DA,DIE Q
26 I COMPL=11 K DA,DR,DIE S DA=SRTN,DIE=130,DR="321////Y;259///Y" D ^DIE K DR,DA,DIE Q
27 I COMPL=12!(COMPL=28) K DA,DR,DIE S DA=SRTN,DIE=130,DR="320////Y;256///Y" D ^DIE K DR,DA,DIE Q
28 I COMPL=13 K DA,DR,DIE S DA=SRTN,DIE=130,DR="320////Y;410///Y" D ^DIE K DR,DA,DIE Q
29 I COMPL=14 K DA,DR,DIE S DA=SRTN,DIE=130,DR="320////Y;287///Y" D ^DIE K DR,DA,DIE Q
30 I COMPL=15 K DA,DR,DIE S DA=SRTN,DIE=130,DR="322////Y;257///Y" D ^DIE K DR,DA,DIE Q
31 I COMPL=16 K DA,DR,DIE S DA=SRTN,DIE=130,DR="321////Y;411///Y" D ^DIE K DR,DA,DIE Q
32 I COMPL=17 K DA,DR,DIE S DA=SRTN,DIE=130,DR="385///Y;321////Y;258///Y" D ^DIE K DR,DA,DIE Q
33 I COMPL=18 K DA,DR,DIE S DA=SRTN,DIE=130,DR="322////Y;345///Y" D ^DIE K DR,DA,DIE Q
34 I COMPL=19 K DA,DR,DIE S DA=SRTN,DIE=130,DR="322////Y;261///Y" D ^DIE K DR,DA,DIE Q
35 I COMPL=20 K DA,DR,DIE S DA=SRTN,DIE=130,DR="322////Y;263///Y" D ^DIE K DR,DA,DIE Q
36 I COMPL=21 K DA,DR,DIE S DA=SRTN,DIE=130,DR="322////Y" D ^DIE K DR,DA,DIE Q
37 I COMPL=22 K DA,DR,DIE S DA=SRTN,DIE=130,DR="403////Y;404///Y" D ^DIE K DR,DA,DIE Q
38 I COMPL=23 K DA,DR,DIE S DA=SRTN,DIE=130,DR="386////Y" D ^DIE K DR,DIE,DA Q
39 I COMPL=24 K DA,DR,DIE S DA=SRTN,DIE=130,DR="387////Y" D ^DIE K DR,DIE,DA Q
40 I COMPL=25 K DA,DR,DIE S DA=SRTN,DIE=130,DR="388////Y" D ^DIE K DR,DIE,DA Q
41 I COMPL=26 K DA,DR,DIE S DA=SRTN,DIE=130,DR="389////Y" D ^DIE K DR,DIE,DA Q
42 I COMPL=27 K DA,DR,DIE S DA=SRTN,DIE=130,DR="391////Y" D ^DIE K DR,DIE,DA Q
43 I COMPL=29 K DA,DR,DIE S DA=SRTN,DIE=130,DR="318////Y" D ^DIE K DR,DA,DIE Q
44 I COMPL=30 K DA,DR,DIE S DA=SRTN,DIE=130,DR="320////Y" D ^DIE K DR,DA,DIE Q
45 I COMPL=31 K DA,DR,DIE S DA=SRTN,DIE=130,DR="319////Y" D ^DIE K DR,DA,DIE Q
46 I COMPL=32 K DA,DR,DIE S DA=SRTN,DIE=130,DR="321////Y" D ^DIE K DR,DA,DIE Q
47 I COMPL=33 K DA,DR,DIE S DA=SRTN,DIE=130,DR="466////Y" D ^DIE K DR,DIE,DA Q
48 I COMPL=34 K DA,DR,DIE S DA=SRTN,DIE=130,DR="467////Y" D ^DIE K DR,DIE,DA Q
49 I COMPL=35 K DA,DR,DIE S DA=SRTN,DIE=130,DR="322////Y;488////Y" D ^DIE K DR,DIE,DA Q
50 I COMPL=36 K DA,DR,DIE S DA=SRTN,DIE=130,DR="403////Y" D ^DIE K DR,DIE,DA Q
51 I COMPL=37 K DA,DR,DIE S DA=SRTN,DIE=130,DR="318////Y;490///Y" D ^DIE K DR,DA,DIE Q
52 I COMPL=38 K DA,DR,DIE S DA=SRTN,DIE=130,DR="322////Y;447////Y" D ^DIE K DR,DIE,DA Q
53 Q
Note: See TracBrowser for help on using the repository browser.