ORRHCT.m

ORRHCT ; SLC/KCM - CPRS Query Tools - TIU ; [4/4/02 2:07pm]

 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**153**;Dec 17, 1997

 ;

NXT() ; Increment ILST

 S ILST=ILST+1

 Q ILST

 ;

DOCSTS(LST)     ; List document statuses

 N ILST,X,IEN S ILST=0

 S X="" F  S X=$O(^TIU(8925.6,"B",X)) Q:X=""  D

 . S IEN=0 F  S IEN=$O(^TIU(8925.6,"B",X,IEN)) Q:'IEN  D

 . . S LST($$NXT)=IEN_U_X

 Q

DOCCLS(Y)       ; Return a list of document classes

 ;  NEED TO GET A TIU RPC

 N IEN,I,X,IDX

 S IEN=$O(^TIU(8925.1,"B","CLINICAL DOCUMENTS",0)),I=0,IDX=0

 F  S I=$O(^TIU(8925.1,IEN,10,I)) Q:'I  D

 . S X=^TIU(8925.1,IEN,10,I,0)

 . Q:$P(X,U,4)="Addendum"

 . S IDX=IDX+1,Y(IDX)=$P(X,U,1)_U_$P(X,U,4)

 Q

ORRHCT    ; SLC/KCM - CPRS Query Tools - TIU ; [4/4/02 2:07pm]

 +1       ;;3.0;ORDER ENTRY/RESULTS REPORTING;**153**;Dec 17, 1997

 +2       ;

NXT()     ; Increment ILST

 +1        SET ILST=ILST+1

 +2        QUIT ILST

 +3       ;

DOCSTS(LST) ; List document statuses

 +1        NEW ILST,X,IEN

           SET ILST=0

 +2        SET X=""

           FOR 

               SET X=$ORDER(^TIU(8925.6,"B",X))

               IF X=""

                   QUIT 

               Begin DoDot:1

 +3                SET IEN=0

                   FOR 

                       SET IEN=$ORDER(^TIU(8925.6,"B",X,IEN))

                       IF 'IEN

                           QUIT 

                       Begin DoDot:2

 +4                        SET LST($$NXT)=IEN_U_X

                       End DoDot:2

               End DoDot:1

 +5        QUIT 

DOCCLS(Y) ; Return a list of document classes

 +1       ;  NEED TO GET A TIU RPC

 +2        NEW IEN,I,X,IDX

 +3        SET IEN=$ORDER(^TIU(8925.1,"B","CLINICAL DOCUMENTS",0))

           SET I=0

           SET IDX=0

 +4        FOR 

               SET I=$ORDER(^TIU(8925.1,IEN,10,I))

               IF 'I

                   QUIT 

               Begin DoDot:1

 +5                SET X=^TIU(8925.1,IEN,10,I,0)

 +6                IF $PIECE(X,U,4)="Addendum"

                       QUIT 

 +7                SET IDX=IDX+1

                   SET Y(IDX)=$PIECE(X,U,1)_U_$PIECE(X,U,4)

               End DoDot:1

 +8        QUIT