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 Sep 11, 2024@03:02:21 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
