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
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSBCHIVH 722 printed Dec 13, 2024@01:39:59 Page 2
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 ;
