LRAPKOE1 ;DSS/FHS - AP LAB ORDER ENTRY CONT ;06/20/16 09:20
;;5.2;LAB SERVICE;**462**;Sep 27, 1994;Build 44
;Reference to ^DIC(130) Supported by ICR #5268
; Reference to DISP^SROSPLG supported by IA #893
Q
DIQ(FILE,DA) ;
K ARR,IEN
D GETS^DIQ(FILE,DA_",",".01;.011;.02;.09;.14;.164;33;34;59;60","","ARR")
S DA=DA_","
I $O(ARR(FILE,DA,60,0)) D
. W !,"Brief Clinical History:"
S IEN=0 F S IEN=$O(ARR(FILE,DA,60,IEN)) Q:IEN<1 D
. W !,ARR(FILE,DA,60,IEN)
I ARR(FILE,DA,33)]"" D
. W !!,"Principle Diagnose: ",ARR(FILE,DA,33)
I $O(ARR(FILE,DA,59,0)) D
. W !!,"Operative Finding:"
. S IEN=0 F S IEN=$O(ARR(FILE,DA,60,IEN)) Q:IEN<1 D
. . W !,ARR(FILE,DA,60,IEN)
I ARR(FILE,DA,34)]"" D
. W !!,"Post Operative Finding:",!,ARR(FILE,DA,34)
W !
Q
SPLG ;Get surgery case #
;S DFN=22850,LRDFN=485918,LRODT=3160419
D ^LRAPKLG
;D:$G(SRTN) DIQ(130,SRTN)
Q
ENDIQ(FILE,DA,DR) ;
D EN^DIQ
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRAPKOE1 931 printed Dec 13, 2024@02:07:34 Page 2
LRAPKOE1 ;DSS/FHS - AP LAB ORDER ENTRY CONT ;06/20/16 09:20
+1 ;;5.2;LAB SERVICE;**462**;Sep 27, 1994;Build 44
+2 ;Reference to ^DIC(130) Supported by ICR #5268
+3 ; Reference to DISP^SROSPLG supported by IA #893
+4 QUIT
DIQ(FILE,DA) ;
+1 KILL ARR,IEN
+2 DO GETS^DIQ(FILE,DA_",",".01;.011;.02;.09;.14;.164;33;34;59;60","","ARR")
+3 SET DA=DA_","
+4 IF $ORDER(ARR(FILE,DA,60,0))
Begin DoDot:1
+5 WRITE !,"Brief Clinical History:"
End DoDot:1
+6 SET IEN=0
FOR
SET IEN=$ORDER(ARR(FILE,DA,60,IEN))
if IEN<1
QUIT
Begin DoDot:1
+7 WRITE !,ARR(FILE,DA,60,IEN)
End DoDot:1
+8 IF ARR(FILE,DA,33)]""
Begin DoDot:1
+9 WRITE !!,"Principle Diagnose: ",ARR(FILE,DA,33)
End DoDot:1
+10 IF $ORDER(ARR(FILE,DA,59,0))
Begin DoDot:1
+11 WRITE !!,"Operative Finding:"
+12 SET IEN=0
FOR
SET IEN=$ORDER(ARR(FILE,DA,60,IEN))
if IEN<1
QUIT
Begin DoDot:2
+13 WRITE !,ARR(FILE,DA,60,IEN)
End DoDot:2
End DoDot:1
+14 IF ARR(FILE,DA,34)]""
Begin DoDot:1
+15 WRITE !!,"Post Operative Finding:",!,ARR(FILE,DA,34)
End DoDot:1
+16 WRITE !
+17 QUIT
SPLG ;Get surgery case #
+1 ;S DFN=22850,LRDFN=485918,LRODT=3160419
+2 DO ^LRAPKLG
+3 ;D:$G(SRTN) DIQ(130,SRTN)
+4 QUIT
ENDIQ(FILE,DA,DR) ;
+1 DO EN^DIQ
+2 QUIT
