PXTTEDL.m

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 ---PXTTEDL   848     printed  Apr 09, 2024@21:33:54                                                                                                                                                                                                      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