PXTTEDL ;ALB/TH - GET AND PRINT EDUCATION SUBTOPIC;11/21/08
;;1.0;PCE PATIENT CARE ENCOUNTER;**193**;Aug 12, 1996;Build 2
;
EN ; Entry point
Q:'$D(^AUTTEDT(D0,10,0))
N PXTTEDL,PXTERR,X,SEQ,SUBTOPIC,X1,DATA
; Get SEQUENCE and SUBTOPIC from Node 10
D GETS^DIQ(9999999.09,D0_",","10*","E","PXTTEDL","PXTERR")
I $D(PXTERR) Q
S (X,SEQ,SUBTOPIC)=""
F S X=$O(PXTTEDL(9999999.091001,X)) Q:'X D
. S SEQ=PXTTEDL(9999999.091001,X,3,"E")
. ; If SEQENCE is null, then set to 0
. I SEQ="" S SEQ=0
. S SUBTOPIC=PXTTEDL(9999999.091001,X,.01,"E")
. S PXTTEDL("P",SEQ,X)=$S(SEQ=0:"",1:SEQ)_U_SUBTOPIC
; Print SEQUENCE and SUBTOPIC
S (SEQ,X1,DATA)=""
F S SEQ=$O(PXTTEDL("P",SEQ)) Q:SEQ="" D
. F S X1=$O(PXTTEDL("P",SEQ,X1)) Q:X1="" D
. . S DATA=PXTTEDL("P",SEQ,X1)
. . W ?12,$P(DATA,U),?17,$E($P(DATA,U,2),1,60),!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXTTEDL 848 printed Oct 16, 2024@18:32:07 Page 2
PXTTEDL ;ALB/TH - GET AND PRINT EDUCATION SUBTOPIC;11/21/08
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**193**;Aug 12, 1996;Build 2
+2 ;
EN ; Entry point
+1 if '$DATA(^AUTTEDT(D0,10,0))
QUIT
+2 NEW PXTTEDL,PXTERR,X,SEQ,SUBTOPIC,X1,DATA
+3 ; Get SEQUENCE and SUBTOPIC from Node 10
+4 DO GETS^DIQ(9999999.09,D0_",","10*","E","PXTTEDL","PXTERR")
+5 IF $DATA(PXTERR)
QUIT
+6 SET (X,SEQ,SUBTOPIC)=""
+7 FOR
SET X=$ORDER(PXTTEDL(9999999.091001,X))
if 'X
QUIT
Begin DoDot:1
+8 SET SEQ=PXTTEDL(9999999.091001,X,3,"E")
+9 ; If SEQENCE is null, then set to 0
+10 IF SEQ=""
SET SEQ=0
+11 SET SUBTOPIC=PXTTEDL(9999999.091001,X,.01,"E")
+12 SET PXTTEDL("P",SEQ,X)=$SELECT(SEQ=0:"",1:SEQ)_U_SUBTOPIC
End DoDot:1
+13 ; Print SEQUENCE and SUBTOPIC
+14 SET (SEQ,X1,DATA)=""
+15 FOR
SET SEQ=$ORDER(PXTTEDL("P",SEQ))
if SEQ=""
QUIT
Begin DoDot:1
+16 FOR
SET X1=$ORDER(PXTTEDL("P",SEQ,X1))
if X1=""
QUIT
Begin DoDot:2
+17 SET DATA=PXTTEDL("P",SEQ,X1)
+18 WRITE ?12,$PIECE(DATA,U),?17,$EXTRACT($PIECE(DATA,U,2),1,60),!
End DoDot:2
End DoDot:1
+19 QUIT
