- SROCCAT ;BIR/MAM - PERIOPERATIVE OCCURRENCE UPDATE (Y/N) FIELDS ;09/29/2011
- ;;3.0;Surgery;**38,47,95,138,153,160,174,176,182,184**;24 Jun 93;Build 35
- S ZTDTH=$H,ZTIO="",ZTRTN="EN^SROCCAT",ZTSAVE("SRTN")="",ZTDESC="Update Perioperative Occurrences for Individual Patient" D ^%ZTLOAD
- Q
- EN ; entry when queued
- 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)
- 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
- .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
- .S CNT=CNT+1,SRCOMPS(CNT)=COMP_"^"_$P(^SRF(SRTN,16,CMP,0),"^",3)
- K DR,DIE,DA S DA=SRTN,DIE=130,DR="[SRO-NOCOMP]" D ^DIE K DR,DA
- I '$D(SRCOMPS(1)) S ZTREQ="@" Q
- S CNT=0 F S CNT=$O(SRCOMPS(CNT)) Q:'CNT S COMPL=$P(SRCOMPS(CNT),"^") D UPDATE
- S ZTREQ="@"
- Q
- UPDATE ; update Y/N questions
- I COMPL=1 K DA,DR,DIE S DA=SRTN,DIE=130,DR="403////Y;248////Y" D ^DIE K DR,DA,DIE Q
- I COMPL=2 K DA,DR,DIE S DA=SRTN,DIE=130,DR="403////Y;249////Y" D ^DIE K DR,DA,DIE Q
- I COMPL=3 K DA,DR,DIE S DA=SRTN,DIE=130,DR="322////Y;250////Y" D ^DIE K DR,DA,DIE Q
- I COMPL=4 K DA,DR,DIE S DA=SRTN,DIE=130,DR="318////Y;251////Y" D ^DIE K DR,DA,DIE Q
- I COMPL=5 K DA,DR,DIE S DA=SRTN,DIE=130,DR="318////Y;252///Y" D ^DIE K DR,DA,DIE Q
- I COMPL=6 K DA,DR,DIE S DA=SRTN,DIE=130,DR="318////Y;285///Y" D ^DIE K DR,DA,DIE Q
- ;I COMPL=7 K DA,DR,DIE S DA=SRTN,DIE=130,DR="318////Y;412///Y" D ^DIE K DR,DA,DIE Q ; inactivated by SR*3*182
- I COMPL=8 K DA,DR,DIE S DA=SRTN,DIE=130,DR="319////Y;409///Y" D ^DIE K DR,DA,DIE Q
- I COMPL=9 K DA,DR,DIE S DA=SRTN,DIE=130,DR="319////Y;254///Y" D ^DIE K DR,DA,DIE Q
- ;I COMPL=10 K DA,DR,DIE S DA=SRTN,DIE=130,DR="319////Y;255///Y" D ^DIE K DR,DA,DIE Q ; inactivated by SR*3*182
- I COMPL=11 K DA,DR,DIE S DA=SRTN,DIE=130,DR="321////Y;259///Y" D ^DIE K DR,DA,DIE Q
- 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
- I COMPL=13 K DA,DR,DIE S DA=SRTN,DIE=130,DR="320////Y;410///Y" D ^DIE K DR,DA,DIE Q
- I COMPL=14 K DA,DR,DIE S DA=SRTN,DIE=130,DR="320////Y;287///Y" D ^DIE K DR,DA,DIE Q
- I COMPL=15 K DA,DR,DIE S DA=SRTN,DIE=130,DR="322////Y;257///Y" D ^DIE K DR,DA,DIE Q
- I COMPL=16 K DA,DR,DIE S DA=SRTN,DIE=130,DR="321////Y;411///Y" D ^DIE K DR,DA,DIE Q
- I COMPL=17 K DA,DR,DIE S DA=SRTN,DIE=130,DR="258///Y;321////Y" D ^DIE K DR,DA,DIE Q
- I COMPL=18 K DA,DR,DIE S DA=SRTN,DIE=130,DR="322////Y;345///Y" D ^DIE K DR,DA,DIE Q
- I COMPL=19 K DA,DR,DIE S DA=SRTN,DIE=130,DR="322////Y;261///Y" D ^DIE K DR,DA,DIE Q
- I COMPL=20 K DA,DR,DIE S DA=SRTN,DIE=130,DR="322////Y;263///Y" D ^DIE K DR,DA,DIE Q
- I COMPL=21 K DA,DR,DIE S DA=SRTN,DIE=130,DR="322////Y" D ^DIE K DR,DA,DIE Q
- I COMPL=22 K DA,DR,DIE S DA=SRTN,DIE=130,DR="403////Y;404///Y" D ^DIE K DR,DA,DIE Q
- I COMPL=23 K DA,DR,DIE S DA=SRTN,DIE=130,DR="386////Y" D ^DIE K DR,DIE,DA Q
- I COMPL=24 K DA,DR,DIE S DA=SRTN,DIE=130,DR="387////Y" D ^DIE K DR,DIE,DA Q
- I COMPL=25 K DA,DR,DIE S DA=SRTN,DIE=130,DR="388////Y" D ^DIE K DR,DIE,DA Q
- I COMPL=26 K DA,DR,DIE S DA=SRTN,DIE=130,DR="389////Y" D ^DIE K DR,DIE,DA Q
- I COMPL=27 K DA,DR,DIE S DA=SRTN,DIE=130,DR="391////Y" D ^DIE K DR,DIE,DA Q
- I COMPL=29 K DA,DR,DIE S DA=SRTN,DIE=130,DR="318////Y" D ^DIE K DR,DA,DIE Q
- I COMPL=30 K DA,DR,DIE S DA=SRTN,DIE=130,DR="320////Y" D ^DIE K DR,DA,DIE Q
- I COMPL=31 K DA,DR,DIE S DA=SRTN,DIE=130,DR="319////Y" D ^DIE K DR,DA,DIE Q
- I COMPL=32 K DA,DR,DIE S DA=SRTN,DIE=130,DR="321////Y" D ^DIE K DR,DA,DIE Q
- I COMPL=33 K DA,DR,DIE S DA=SRTN,DIE=130,DR="466////Y" D ^DIE K DR,DIE,DA Q
- I COMPL=34 K DA,DR,DIE S DA=SRTN,DIE=130,DR="467////Y" D ^DIE K DR,DIE,DA Q
- I COMPL=35 K DA,DR,DIE S DA=SRTN,DIE=130,DR="322////Y;488////Y" D ^DIE K DR,DIE,DA Q
- I COMPL=36 K DA,DR,DIE S DA=SRTN,DIE=130,DR="403////Y" D ^DIE K DR,DIE,DA Q
- ;I COMPL=37 K DA,DR,DIE S DA=SRTN,DIE=130,DR="318////Y;490///Y" D ^DIE K DR,DA,DIE Q ; inactivated by SR*3*182
- I COMPL=38 K DA,DR,DIE S DA=SRTN,DIE=130,DR="322////Y;447////Y" D ^DIE K DR,DIE,DA Q
- I COMPL=39 K DA,DR,DIE S DA=SRTN,DIE=130,DR="448////Y" D ^DIE K DR,DIE,DA Q
- I COMPL=40 K DA,DR,DIE S DA=SRTN,DIE=130,DR="319////Y;644////Y" D ^DIE K DR,DIE,DA Q
- ;I COMPL=41 K DA,DR,DIE S DA=SRTN,DIE=130,DR="318////Y;645///Y" D ^DIE K DR,DA,DIE Q
- I COMPL=42 K DA,DR,DIE S DA=SRTN,DIE=130,DR="318////Y;422///Y" D ^DIE K DR,DA,DIE Q
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROCCAT 4509 printed Feb 19, 2025@00:09:02 Page 2
- SROCCAT ;BIR/MAM - PERIOPERATIVE OCCURRENCE UPDATE (Y/N) FIELDS ;09/29/2011
- +1 ;;3.0;Surgery;**38,47,95,138,153,160,174,176,182,184**;24 Jun 93;Build 35
- +2 SET ZTDTH=$HOROLOG
- SET ZTIO=""
- SET ZTRTN="EN^SROCCAT"
- SET ZTSAVE("SRTN")=""
- SET ZTDESC="Update Perioperative Occurrences for Individual Patient"
- DO ^%ZTLOAD
- +3 QUIT
- EN ; entry when queued
- +1 KILL SRCOMPS
- SET (CNT,CMP)=0
- FOR
- SET CMP=$ORDER(^SRF(SRTN,10,CMP))
- if 'CMP
- QUIT
- SET COMP=$PIECE(^SRF(SRTN,10,CMP,0),"^",2)
- IF COMP
- SET CNT=CNT+1
- SET SRCOMPS(CNT)=COMP_"^"_$PIECE(^(0),"^",3)
- +2 SET CMP=0
- FOR
- SET CMP=$ORDER(^SRF(SRTN,16,CMP))
- if 'CMP
- QUIT
- SET COMP=$PIECE(^SRF(SRTN,16,CMP,0),"^",2)
- IF COMP
- SET SRDATE=""
- Begin DoDot:1
- +3 SET SRDATE=$EXTRACT($PIECE(^SRF(SRTN,16,CMP,0),"^",7),1,7)
- IF SRDATE
- SET X1=$EXTRACT($PIECE(^SRF(SRTN,0),"^",9),1,7)
- SET X2=30
- DO C^%DTC
- IF SRDATE>X
- QUIT
- +4 SET CNT=CNT+1
- SET SRCOMPS(CNT)=COMP_"^"_$PIECE(^SRF(SRTN,16,CMP,0),"^",3)
- End DoDot:1
- +5 KILL DR,DIE,DA
- SET DA=SRTN
- SET DIE=130
- SET DR="[SRO-NOCOMP]"
- DO ^DIE
- KILL DR,DA
- +6 IF '$DATA(SRCOMPS(1))
- SET ZTREQ="@"
- QUIT
- +7 SET CNT=0
- FOR
- SET CNT=$ORDER(SRCOMPS(CNT))
- if 'CNT
- QUIT
- SET COMPL=$PIECE(SRCOMPS(CNT),"^")
- DO UPDATE
- +8 SET ZTREQ="@"
- +9 QUIT
- UPDATE ; update Y/N questions
- +1 IF COMPL=1
- KILL DA,DR,DIE
- SET DA=SRTN
- SET DIE=130
- SET DR="403////Y;248////Y"
- DO ^DIE
- KILL DR,DA,DIE
- QUIT
- +2 IF COMPL=2
- KILL DA,DR,DIE
- SET DA=SRTN
- SET DIE=130
- SET DR="403////Y;249////Y"
- DO ^DIE
- KILL DR,DA,DIE
- QUIT
- +3 IF COMPL=3
- KILL DA,DR,DIE
- SET DA=SRTN
- SET DIE=130
- SET DR="322////Y;250////Y"
- DO ^DIE
- KILL DR,DA,DIE
- QUIT
- +4 IF COMPL=4
- KILL DA,DR,DIE
- SET DA=SRTN
- SET DIE=130
- SET DR="318////Y;251////Y"
- DO ^DIE
- KILL DR,DA,DIE
- QUIT
- +5 IF COMPL=5
- KILL DA,DR,DIE
- SET DA=SRTN
- SET DIE=130
- SET DR="318////Y;252///Y"
- DO ^DIE
- KILL DR,DA,DIE
- QUIT
- +6 IF COMPL=6
- KILL DA,DR,DIE
- SET DA=SRTN
- SET DIE=130
- SET DR="318////Y;285///Y"
- DO ^DIE
- KILL DR,DA,DIE
- QUIT
- +7 ;I COMPL=7 K DA,DR,DIE S DA=SRTN,DIE=130,DR="318////Y;412///Y" D ^DIE K DR,DA,DIE Q ; inactivated by SR*3*182
- +8 IF COMPL=8
- KILL DA,DR,DIE
- SET DA=SRTN
- SET DIE=130
- SET DR="319////Y;409///Y"
- DO ^DIE
- KILL DR,DA,DIE
- QUIT
- +9 IF COMPL=9
- KILL DA,DR,DIE
- SET DA=SRTN
- SET DIE=130
- SET DR="319////Y;254///Y"
- DO ^DIE
- KILL DR,DA,DIE
- QUIT
- +10 ;I COMPL=10 K DA,DR,DIE S DA=SRTN,DIE=130,DR="319////Y;255///Y" D ^DIE K DR,DA,DIE Q ; inactivated by SR*3*182
- +11 IF COMPL=11
- KILL DA,DR,DIE
- SET DA=SRTN
- SET DIE=130
- SET DR="321////Y;259///Y"
- DO ^DIE
- KILL DR,DA,DIE
- QUIT
- +12 IF COMPL=12!(COMPL=28)
- KILL DA,DR,DIE
- SET DA=SRTN
- SET DIE=130
- SET DR="320////Y;256///Y"
- DO ^DIE
- KILL DR,DA,DIE
- QUIT
- +13 IF COMPL=13
- KILL DA,DR,DIE
- SET DA=SRTN
- SET DIE=130
- SET DR="320////Y;410///Y"
- DO ^DIE
- KILL DR,DA,DIE
- QUIT
- +14 IF COMPL=14
- KILL DA,DR,DIE
- SET DA=SRTN
- SET DIE=130
- SET DR="320////Y;287///Y"
- DO ^DIE
- KILL DR,DA,DIE
- QUIT
- +15 IF COMPL=15
- KILL DA,DR,DIE
- SET DA=SRTN
- SET DIE=130
- SET DR="322////Y;257///Y"
- DO ^DIE
- KILL DR,DA,DIE
- QUIT
- +16 IF COMPL=16
- KILL DA,DR,DIE
- SET DA=SRTN
- SET DIE=130
- SET DR="321////Y;411///Y"
- DO ^DIE
- KILL DR,DA,DIE
- QUIT
- +17 IF COMPL=17
- KILL DA,DR,DIE
- SET DA=SRTN
- SET DIE=130
- SET DR="258///Y;321////Y"
- DO ^DIE
- KILL DR,DA,DIE
- QUIT
- +18 IF COMPL=18
- KILL DA,DR,DIE
- SET DA=SRTN
- SET DIE=130
- SET DR="322////Y;345///Y"
- DO ^DIE
- KILL DR,DA,DIE
- QUIT
- +19 IF COMPL=19
- KILL DA,DR,DIE
- SET DA=SRTN
- SET DIE=130
- SET DR="322////Y;261///Y"
- DO ^DIE
- KILL DR,DA,DIE
- QUIT
- +20 IF COMPL=20
- KILL DA,DR,DIE
- SET DA=SRTN
- SET DIE=130
- SET DR="322////Y;263///Y"
- DO ^DIE
- KILL DR,DA,DIE
- QUIT
- +21 IF COMPL=21
- KILL DA,DR,DIE
- SET DA=SRTN
- SET DIE=130
- SET DR="322////Y"
- DO ^DIE
- KILL DR,DA,DIE
- QUIT
- +22 IF COMPL=22
- KILL DA,DR,DIE
- SET DA=SRTN
- SET DIE=130
- SET DR="403////Y;404///Y"
- DO ^DIE
- KILL DR,DA,DIE
- QUIT
- +23 IF COMPL=23
- KILL DA,DR,DIE
- SET DA=SRTN
- SET DIE=130
- SET DR="386////Y"
- DO ^DIE
- KILL DR,DIE,DA
- QUIT
- +24 IF COMPL=24
- KILL DA,DR,DIE
- SET DA=SRTN
- SET DIE=130
- SET DR="387////Y"
- DO ^DIE
- KILL DR,DIE,DA
- QUIT
- +25 IF COMPL=25
- KILL DA,DR,DIE
- SET DA=SRTN
- SET DIE=130
- SET DR="388////Y"
- DO ^DIE
- KILL DR,DIE,DA
- QUIT
- +26 IF COMPL=26
- KILL DA,DR,DIE
- SET DA=SRTN
- SET DIE=130
- SET DR="389////Y"
- DO ^DIE
- KILL DR,DIE,DA
- QUIT
- +27 IF COMPL=27
- KILL DA,DR,DIE
- SET DA=SRTN
- SET DIE=130
- SET DR="391////Y"
- DO ^DIE
- KILL DR,DIE,DA
- QUIT
- +28 IF COMPL=29
- KILL DA,DR,DIE
- SET DA=SRTN
- SET DIE=130
- SET DR="318////Y"
- DO ^DIE
- KILL DR,DA,DIE
- QUIT
- +29 IF COMPL=30
- KILL DA,DR,DIE
- SET DA=SRTN
- SET DIE=130
- SET DR="320////Y"
- DO ^DIE
- KILL DR,DA,DIE
- QUIT
- +30 IF COMPL=31
- KILL DA,DR,DIE
- SET DA=SRTN
- SET DIE=130
- SET DR="319////Y"
- DO ^DIE
- KILL DR,DA,DIE
- QUIT
- +31 IF COMPL=32
- KILL DA,DR,DIE
- SET DA=SRTN
- SET DIE=130
- SET DR="321////Y"
- DO ^DIE
- KILL DR,DA,DIE
- QUIT
- +32 IF COMPL=33
- KILL DA,DR,DIE
- SET DA=SRTN
- SET DIE=130
- SET DR="466////Y"
- DO ^DIE
- KILL DR,DIE,DA
- QUIT
- +33 IF COMPL=34
- KILL DA,DR,DIE
- SET DA=SRTN
- SET DIE=130
- SET DR="467////Y"
- DO ^DIE
- KILL DR,DIE,DA
- QUIT
- +34 IF COMPL=35
- KILL DA,DR,DIE
- SET DA=SRTN
- SET DIE=130
- SET DR="322////Y;488////Y"
- DO ^DIE
- KILL DR,DIE,DA
- QUIT
- +35 IF COMPL=36
- KILL DA,DR,DIE
- SET DA=SRTN
- SET DIE=130
- SET DR="403////Y"
- DO ^DIE
- KILL DR,DIE,DA
- QUIT
- +36 ;I COMPL=37 K DA,DR,DIE S DA=SRTN,DIE=130,DR="318////Y;490///Y" D ^DIE K DR,DA,DIE Q ; inactivated by SR*3*182
- +37 IF COMPL=38
- KILL DA,DR,DIE
- SET DA=SRTN
- SET DIE=130
- SET DR="322////Y;447////Y"
- DO ^DIE
- KILL DR,DIE,DA
- QUIT
- +38 IF COMPL=39
- KILL DA,DR,DIE
- SET DA=SRTN
- SET DIE=130
- SET DR="448////Y"
- DO ^DIE
- KILL DR,DIE,DA
- QUIT
- +39 IF COMPL=40
- KILL DA,DR,DIE
- SET DA=SRTN
- SET DIE=130
- SET DR="319////Y;644////Y"
- DO ^DIE
- KILL DR,DIE,DA
- QUIT
- +40 ;I COMPL=41 K DA,DR,DIE S DA=SRTN,DIE=130,DR="318////Y;645///Y" D ^DIE K DR,DA,DIE Q
- +41 IF COMPL=42
- KILL DA,DR,DIE
- SET DA=SRTN
- SET DIE=130
- SET DR="318////Y;422///Y"
- DO ^DIE
- KILL DR,DA,DIE
- QUIT
- +42 QUIT