LRAPKLG1 ;DSS/FHS - STATUS OF SURGICAL CASE ;08/10/16 09:35
;;5.2;LAB SERVICE;**462**;Sep 27, 1994;Build 44
; Supported calls AI #, 5286,103,3615
STATUS(LRCASE) ; GET Surgery case status
N ANS,ERR,LRSDOC
S:'$D(LROPER) LROPER=""
;GET SURGEON
S LRSDOC=$S($P($G(^SRF(LRCASE,"NON")),U)="Y":$P(^("NON"),U,6),1:$P($G(^SRF(LRCASE,.1)),U,4))
S LRSURPHY="DR:"_$$GET1^DIQ(200,LRSDOC_",",.01,"ANS","ERR")
I $P($G(^SRF(LRCASE,"NON")),U)="Y" S LROPER=LROPER_$S($P($G(^(30)),U):" (ABORTED)",$P($G(^("NON")),U,5):" (COMPLETED)",1:" (NOT COMPLETE)")_" "_LRSURPHY Q
I $P($G(^SRF(LRCASE,30)),U)'="" D CAN Q
I $P($G(^SRF(LRCASE,31)),U,8)'="" D CAN Q
I $P($G(^SRF(LRCASE,.2)),U,12) S LROPER=LROPER_" (COMPLETED)"_" "_LRSURPHY Q
I $D(^SRF(LRCASE,.2)),$P(^(.2),U,12)="" S LRSTAT=0 D SCH I LRSTATUS=0 D REQ Q:LRSTATUS G NO
I '$D(^SRF(LRCASE,.2)) S LRSTAT=0 D SCH I LRSTATUS=0 D REQ Q:LRSTATUS=1 G NO
Q
NO ; not requested or scheduled
S LROPER=LROPER_" (NOT COMPLETE)"_" "_LRSURPHY
Q
CAN ; cancelled or aborted
N LRV
S LRV(.2)=$G(^SRF(LRCASE,.2))
I $P(LRV(.2),U)!($P(LRV(.2),U,10)) S LROPER=LROPER_" (ABORTED)"_" "_LRSURPHY Q
S LROPER=LROPER_" (CANCELLED)"_" "_LRSURPHY
Q
SCH ; check to see if case is scheduled
I '$D(^SRF(LRCASE,31)) S LRSTATUS=0 Q
I $P($G(^SRF(LRCASE,31)),U,4)="" S LRSTATUS=0 Q
I $P($G(^SRF(LRCASE,31)),U,4) D:LRSTAT=0 TIM0 D:LRSTAT=1 TIM1 S LRSTATUS=1 Q
Q
TIM0 I '$D(^SRF(LRCASE,.2)) S LROPER=LROPER_" (SCHEDULED)"_" "_LRSURPHY Q
I $P(^SRF(LRCASE,.2),U,2) S LROPER=LROPER_" (NOT COMPLETE)"_" "_LRSURPHY Q
I $P(^SRF(LRCASE,.2),U,2)="" S LROPER=LROPER_" (SCHEDULED)"_" "_LRSURPHY
Q
TIM1 S LROPER=LROPER_" (SCHEDULED)"_" "_LRSURPHY Q
REQ ; check to see if case has been requested
I $D(^SRF(LRCASE,"REQ")),$P(^("REQ"),U)=1,'$D(^SRF(LRCASE,.2)) S LROPER=LROPER_" (REQUESTED)"_" "_LRSURPHY S LRSTATUS=1 Q
I $D(^SRF(LRCASE,"REQ")),$P(^("REQ"),U)=1,$D(^SRF(LRCASE,.2)),$P(^(.2),U,2)="" S LROPER=LROPER_" (REQUESTED)"_" "_LRSURPHY S LRSTATUS=1
Q
ABORT ; aborted case
S LRABORT=0 I $D(^SRF(LRCASE,.2)),$P(^(.2),U,10)'="" S LRABORT=1
Q
STORE(LRDFN,LRSS,LRIDT,LRDIAL) ;Load the surgery dialog into ^LR(
;LRHDR ARRAY SET IN DISPLAY^LRAPKLG
;Where "X" = array subscript
;LRHDR(33,X)="Preoperative diagnosis"
;LRHDR(34,X)="Post Opertive Diag"
;LRHDR(38,X)="Operative Finding"
;LRHDR(39,X)="Brief Clinical History"
Q:'$G(LROK)
N ANS,X,Y,IEN,FDA,LRX
S LRIEN=LRIDT_","_LRDFN_","
S FIL=$S(LRSS="SP":63.08,LRSS="CY":63.09,LRSS="EM":63.02,1:"")
Q:FIL=""
S IEN=2 F S IEN=$O(LRDIAL(IEN)) Q:IEN<1 D
. S FDA=$S(IEN=39:.013,IEN=33:.014,IEN=38:.015,IEN=34:.016,1:0)
. K ERR D WP^DIE(FIL,LRIEN,FDA,"A","LRDIAL("_IEN_")","ERR")
W !!,$$CJ^XLFSTR("Surgery data transfer is completed",IOM),!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRAPKLG1 2772 printed Sep 23, 2025@19:43:12 Page 2
LRAPKLG1 ;DSS/FHS - STATUS OF SURGICAL CASE ;08/10/16 09:35
+1 ;;5.2;LAB SERVICE;**462**;Sep 27, 1994;Build 44
+2 ; Supported calls AI #, 5286,103,3615
STATUS(LRCASE) ; GET Surgery case status
+1 NEW ANS,ERR,LRSDOC
+2 if '$DATA(LROPER)
SET LROPER=""
+3 ;GET SURGEON
+4 SET LRSDOC=$SELECT($PIECE($GET(^SRF(LRCASE,"NON")),U)="Y":$PIECE(^("NON"),U,6),1:$PIECE($GET(^SRF(LRCASE,.1)),U,4))
+5 SET LRSURPHY="DR:"_$$GET1^DIQ(200,LRSDOC_",",.01,"ANS","ERR")
+6 IF $PIECE($GET(^SRF(LRCASE,"NON")),U)="Y"
SET LROPER=LROPER_$SELECT($PIECE($GET(^(30)),U):" (ABORTED)",$PIECE($GET(^("NON")),U,5):" (COMPLETED)",1:" (NOT COMPLETE)")_" "_LRSURPHY
QUIT
+7 IF $PIECE($GET(^SRF(LRCASE,30)),U)'=""
DO CAN
QUIT
+8 IF $PIECE($GET(^SRF(LRCASE,31)),U,8)'=""
DO CAN
QUIT
+9 IF $PIECE($GET(^SRF(LRCASE,.2)),U,12)
SET LROPER=LROPER_" (COMPLETED)"_" "_LRSURPHY
QUIT
+10 IF $DATA(^SRF(LRCASE,.2))
IF $PIECE(^(.2),U,12)=""
SET LRSTAT=0
DO SCH
IF LRSTATUS=0
DO REQ
if LRSTATUS
QUIT
GOTO NO
+11 IF '$DATA(^SRF(LRCASE,.2))
SET LRSTAT=0
DO SCH
IF LRSTATUS=0
DO REQ
if LRSTATUS=1
QUIT
GOTO NO
+12 QUIT
NO ; not requested or scheduled
+1 SET LROPER=LROPER_" (NOT COMPLETE)"_" "_LRSURPHY
+2 QUIT
CAN ; cancelled or aborted
+1 NEW LRV
+2 SET LRV(.2)=$GET(^SRF(LRCASE,.2))
+3 IF $PIECE(LRV(.2),U)!($PIECE(LRV(.2),U,10))
SET LROPER=LROPER_" (ABORTED)"_" "_LRSURPHY
QUIT
+4 SET LROPER=LROPER_" (CANCELLED)"_" "_LRSURPHY
+5 QUIT
SCH ; check to see if case is scheduled
+1 IF '$DATA(^SRF(LRCASE,31))
SET LRSTATUS=0
QUIT
+2 IF $PIECE($GET(^SRF(LRCASE,31)),U,4)=""
SET LRSTATUS=0
QUIT
+3 IF $PIECE($GET(^SRF(LRCASE,31)),U,4)
if LRSTAT=0
DO TIM0
if LRSTAT=1
DO TIM1
SET LRSTATUS=1
QUIT
+4 QUIT
TIM0 IF '$DATA(^SRF(LRCASE,.2))
SET LROPER=LROPER_" (SCHEDULED)"_" "_LRSURPHY
QUIT
+1 IF $PIECE(^SRF(LRCASE,.2),U,2)
SET LROPER=LROPER_" (NOT COMPLETE)"_" "_LRSURPHY
QUIT
+2 IF $PIECE(^SRF(LRCASE,.2),U,2)=""
SET LROPER=LROPER_" (SCHEDULED)"_" "_LRSURPHY
+3 QUIT
TIM1 SET LROPER=LROPER_" (SCHEDULED)"_" "_LRSURPHY
QUIT
REQ ; check to see if case has been requested
+1 IF $DATA(^SRF(LRCASE,"REQ"))
IF $PIECE(^("REQ"),U)=1
IF '$DATA(^SRF(LRCASE,.2))
SET LROPER=LROPER_" (REQUESTED)"_" "_LRSURPHY
SET LRSTATUS=1
QUIT
+2 IF $DATA(^SRF(LRCASE,"REQ"))
IF $PIECE(^("REQ"),U)=1
IF $DATA(^SRF(LRCASE,.2))
IF $PIECE(^(.2),U,2)=""
SET LROPER=LROPER_" (REQUESTED)"_" "_LRSURPHY
SET LRSTATUS=1
+3 QUIT
ABORT ; aborted case
+1 SET LRABORT=0
IF $DATA(^SRF(LRCASE,.2))
IF $PIECE(^(.2),U,10)'=""
SET LRABORT=1
+2 QUIT
STORE(LRDFN,LRSS,LRIDT,LRDIAL) ;Load the surgery dialog into ^LR(
+1 ;LRHDR ARRAY SET IN DISPLAY^LRAPKLG
+2 ;Where "X" = array subscript
+3 ;LRHDR(33,X)="Preoperative diagnosis"
+4 ;LRHDR(34,X)="Post Opertive Diag"
+5 ;LRHDR(38,X)="Operative Finding"
+6 ;LRHDR(39,X)="Brief Clinical History"
+7 if '$GET(LROK)
QUIT
+8 NEW ANS,X,Y,IEN,FDA,LRX
+9 SET LRIEN=LRIDT_","_LRDFN_","
+10 SET FIL=$SELECT(LRSS="SP":63.08,LRSS="CY":63.09,LRSS="EM":63.02,1:"")
+11 if FIL=""
QUIT
+12 SET IEN=2
FOR
SET IEN=$ORDER(LRDIAL(IEN))
if IEN<1
QUIT
Begin DoDot:1
+13 SET FDA=$SELECT(IEN=39:.013,IEN=33:.014,IEN=38:.015,IEN=34:.016,1:0)
+14 KILL ERR
DO WP^DIE(FIL,LRIEN,FDA,"A","LRDIAL("_IEN_")","ERR")
End DoDot:1
+15 WRITE !!,$$CJ^XLFSTR("Surgery data transfer is completed",IOM),!
+16 QUIT
