- 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 Jan 18, 2025@02:41:13 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 ;