HMPDPSOR.m

HMPDPSOR ;SLC/MKB,ASMR/RRB,SRG - Medication extract by order;10/2/15  15:29

 ;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**2**;Sep 01, 2011;Build 28

 ;Per VA Directive 6402, this routine should not be modified.

 ;

 ; External References          DBIA#

 ; -------------------          -----

 ; ^OR(100                       5771

 ; ^ORD(100.98                    873

 ; ^SC                          10040

 ; ^VA(200                      10060

 ; DIQ                           2056

 ; ORCD                          5493

 ; ORQ1,^TMP("ORR",$J)           3154

 ; ORX8                 871,2467,3071

 ; PSOORRL,^TMP("PS",$J)         2400

 ; PSS50P7                       4662

 ; PSS51P2                       4548

 ;

 Q

 ;----------- Get data from VistA --------------

 ;

STATUS(X) ; -- return HITSP status for 100.01 #X

 S X=+$G(X) S:'X X=99  ;no status

 I X=3 Q "hold"

 I X=10!(X=11)!(X=5) Q "not active"

 I X=1!(X=12)!(X=13) Q "not active"

 I X=14!(X=99)       Q "not active"

 I X=2!(X=7)!(X=15)  Q "historical"

 Q "active"

 ;

RESP(ORIFN,RESP) ; -- return order responses [internal form]

 N HMPDLG,I,J,W,ID,TYPE,X,Y

 I '$D(ORDIALOG) S ORDIALOG=129 D GETDLG1^ORCD(129)

 D GETORDER^ORCD(+$G(ORIFN),"HMPDLG")

 S I=0 F  S I=$O(HMPDLG(I)) Q:I<1  D

 . S ID=$P($G(ORDIALOG(I)),U,2) Q:'$L(ID)

 . S TYPE=$P($G(ORDIALOG(I,0)),U)

 . S J=0 F  S J=$O(HMPDLG(I,J)) Q:J<1  I $D(HMPDLG(I,J)) D

 .. S X=HMPDLG(I,J) I TYPE'="W" S RESP(ID,J)=X Q

 .. S Y=$G(@X@(1,0)),W=1 F  S W=$O(@X@(W)) Q:W<1  S Y=Y_$S($E(Y,$L(Y))'=" ":" ",1:"")_$G(@X@(W,0))

 .. S:$L(Y) RESP(ID,J)=Y

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---HMPDPSOR   1593     printed  Apr 23, 2025@18:08:10                                                                                                                                                                                                    Page 2

HMPDPSOR  ;SLC/MKB,ASMR/RRB,SRG - Medication extract by order;10/2/15  15:29

 +1       ;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**2**;Sep 01, 2011;Build 28

 +2       ;Per VA Directive 6402, this routine should not be modified.

 +3       ;

 +4       ; External References          DBIA#

 +5       ; -------------------          -----

 +6       ; ^OR(100                       5771

 +7       ; ^ORD(100.98                    873

 +8       ; ^SC                          10040

 +9       ; ^VA(200                      10060

 +10      ; DIQ                           2056

 +11      ; ORCD                          5493

 +12      ; ORQ1,^TMP("ORR",$J)           3154

 +13      ; ORX8                 871,2467,3071

 +14      ; PSOORRL,^TMP("PS",$J)         2400

 +15      ; PSS50P7                       4662

 +16      ; PSS51P2                       4548

 +17      ;

 +18       QUIT 

 +19      ;----------- Get data from VistA --------------

 +20      ;

STATUS(X) ; -- return HITSP status for 100.01 #X

 +1       ;no status

           SET X=+$GET(X)

           if 'X

               SET X=99

 +2        IF X=3

               QUIT "hold"

 +3        IF X=10!(X=11)!(X=5)

               QUIT "not active"

 +4        IF X=1!(X=12)!(X=13)

               QUIT "not active"

 +5        IF X=14!(X=99)

               QUIT "not active"

 +6        IF X=2!(X=7)!(X=15)

               QUIT "historical"

 +7        QUIT "active"

 +8       ;

RESP(ORIFN,RESP) ; -- return order responses [internal form]

 +1        NEW HMPDLG,I,J,W,ID,TYPE,X,Y

 +2        IF '$DATA(ORDIALOG)

               SET ORDIALOG=129

               DO GETDLG1^ORCD(129)

 +3        DO GETORDER^ORCD(+$GET(ORIFN),"HMPDLG")

 +4        SET I=0

           FOR 

               SET I=$ORDER(HMPDLG(I))

               if I<1

                   QUIT 

               Begin DoDot:1

 +5                SET ID=$PIECE($GET(ORDIALOG(I)),U,2)

                   if '$LENGTH(ID)

                       QUIT 

 +6                SET TYPE=$PIECE($GET(ORDIALOG(I,0)),U)

 +7                SET J=0

                   FOR 

                       SET J=$ORDER(HMPDLG(I,J))

                       if J<1

                           QUIT 

                       IF $DATA(HMPDLG(I,J))

                           Begin DoDot:2

 +8                            SET X=HMPDLG(I,J)

                               IF TYPE'="W"

                                   SET RESP(ID,J)=X

                                   QUIT 

 +9                            SET Y=$GET(@X@(1,0))

                               SET W=1

                               FOR 

                                   SET W=$ORDER(@X@(W))

                                   if W<1

                                       QUIT 

                                   SET Y=Y_$SELECT($EXTRACT(Y,$LENGTH(Y))'=" ":" ",1:"")_$GET(@X@(W,0))

 +10                           if $LENGTH(Y)

                                   SET RESP(ID,J)=Y

                           End DoDot:2

               End DoDot:1

 +11       QUIT