- 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 Feb 18, 2025@23:57:47 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