PSBCHIVH.m

PSBCHIVH ;BIRMINGHAM/BSR-BCMA CHECK IV ROUTINE ;Mar 2004

 ;;3.0;BAR CODE MED ADMIN;;Mar 2004

 ;

 ;This routine will retrievehistory order numbers. 

 ;

GETORD(PSBORD)    ;

 S PSBONXS=PSBORD_"^"

 F PSBC1=1:1 Q:$P(PSBONXS,U,PSBC1)=""  D  ; process all orders

 .D CLEAN^PSBVT,PSJ1^PSBVT(DFN,$P(PSBONXS,U,PSBC1))

 .I $G(PSBPONX)]"",$G(PSBPONX)["P" S PSBPONX2=PSBPONX D  ; Must compare

 ..F  D CLEAN^PSBVT,PSJ1^PSBVT(DFN,PSBPONX2) S PSBPONX2=PSBPONX  Q:(PSBPONX2="")!(PSBPONX2'["P")  ;

 ..D CLEAN^PSBVT,PSJ1^PSBVT(DFN,$P(PSBONXS,U,PSBC1))  ; Refresh data

 ..S:$D(PSBPONX2) PSBPONX=PSBPONX2 K PSBPONX2

 .Q:($L(U_PSBONXS,U_PSBPONX_U)-1)>0

 .I $G(PSBPONX)]"" S PSBONXS=PSBONXS_PSBPONX_U

 S PSBONXSB=PSBONXS

 Q

 ;

PSBCHIVH  ;BIRMINGHAM/BSR-BCMA CHECK IV ROUTINE ;Mar 2004

 +1       ;;3.0;BAR CODE MED ADMIN;;Mar 2004

 +2       ;

 +3       ;This routine will retrievehistory order numbers. 

 +4       ;

GETORD(PSBORD) ;

 +1        SET PSBONXS=PSBORD_"^"

 +2       ; process all orders

           FOR PSBC1=1:1

               IF $PIECE(PSBONXS,U,PSBC1)=""

                   QUIT 

               Begin DoDot:1

 +3                DO CLEAN^PSBVT

                   DO PSJ1^PSBVT(DFN,$PIECE(PSBONXS,U,PSBC1))

 +4       ; Must compare

                   IF $GET(PSBPONX)]""

                       IF $GET(PSBPONX)["P"

                           SET PSBPONX2=PSBPONX

                           Begin DoDot:2

 +5       ;

                               FOR 

                                   DO CLEAN^PSBVT

                                   DO PSJ1^PSBVT(DFN,PSBPONX2)

                                   SET PSBPONX2=PSBPONX

                                   IF (PSBPONX2="")!(PSBPONX2'["P")

                                       QUIT 

 +6       ; Refresh data

                               DO CLEAN^PSBVT

                               DO PSJ1^PSBVT(DFN,$PIECE(PSBONXS,U,PSBC1))

 +7                            IF $DATA(PSBPONX2)

                                   SET PSBPONX=PSBPONX2

                               KILL PSBPONX2

                           End DoDot:2

 +8                IF ($LENGTH(U_PSBONXS,U_PSBPONX_U)-1)>0

                       QUIT 

 +9                IF $GET(PSBPONX)]""

                       SET PSBONXS=PSBONXS_PSBPONX_U

               End DoDot:1

 +10       SET PSBONXSB=PSBONXS

 +11       QUIT 

 +12      ;