- PSBVPR ;SLC/JLC,ASMR/BL- BCMA-VPR UTILITIES ; 10/16/15 1:54pm
- ;;3.0;BAR CODE MED ADMIN;**79**;Mar 2004;Build 172
- ;Per VA Directive 6402, this routine should not be modified.
- ;
- ;
- ADMIN(RESULTS,PSBVDFN,PSBORDNO,PSBVADT) ;
- I $G(PSBVDFN)="" Q -1
- I $G(PSBORDNO)="" Q -2
- K ^TMP("PSB",$J) N PSBI,A,PSBA,S1,X1,X2,X
- I '$G(PSBVADT) D NOW^%DTC S PSBVADT=%
- D GETINFO
- S RESULTS=$O(PSBA(PSBVADT-.0001)) I 'RESULTS S X1=PSBVADT,X2=1 D C^%DTC S PSBVADT=X D GETINFO
- S RESULTS=$O(PSBA(PSBVADT-.0001))
- Q
- GETINFO ;
- I PSBORDNO?.E1"U" D RPC^PSBVDLTB(,PSBVDFN,"UDTAB",PSBVADT) M ^TMP("PSBVPR",$J)=^TMP("PSB",$J,"UDTAB")
- I PSBORDNO?.E1"V" F PSBI="IVTAB","PBTAB" D RPC^PSBVDLTB(,PSBVDFN,PSBI,$G(PSBVADT)) M ^TMP("PSBVPR",$J)=^TMP("PSB",$J,PSBI)
- S S1=0 F S S1=$O(^TMP("PSBVPR",$J,S1)) Q:'S1 D
- . S A=^TMP("PSBVPR",$J,S1) I $P(A,"^")'=PSBVDFN Q
- . I $P(A,"^",2)'=PSBORDNO Q
- . S PSBA($P(A,"^",14))=""
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSBVPR 916 printed Feb 18, 2025@23:07:49 Page 2
- PSBVPR ;SLC/JLC,ASMR/BL- BCMA-VPR UTILITIES ; 10/16/15 1:54pm
- +1 ;;3.0;BAR CODE MED ADMIN;**79**;Mar 2004;Build 172
- +2 ;Per VA Directive 6402, this routine should not be modified.
- +3 ;
- +4 ;
- ADMIN(RESULTS,PSBVDFN,PSBORDNO,PSBVADT) ;
- +1 IF $GET(PSBVDFN)=""
- QUIT -1
- +2 IF $GET(PSBORDNO)=""
- QUIT -2
- +3 KILL ^TMP("PSB",$JOB)
- NEW PSBI,A,PSBA,S1,X1,X2,X
- +4 IF '$GET(PSBVADT)
- DO NOW^%DTC
- SET PSBVADT=%
- +5 DO GETINFO
- +6 SET RESULTS=$ORDER(PSBA(PSBVADT-.0001))
- IF 'RESULTS
- SET X1=PSBVADT
- SET X2=1
- DO C^%DTC
- SET PSBVADT=X
- DO GETINFO
- +7 SET RESULTS=$ORDER(PSBA(PSBVADT-.0001))
- +8 QUIT
- GETINFO ;
- +1 IF PSBORDNO?.E1"U"
- DO RPC^PSBVDLTB(,PSBVDFN,"UDTAB",PSBVADT)
- MERGE ^TMP("PSBVPR",$JOB)=^TMP("PSB",$JOB,"UDTAB")
- +2 IF PSBORDNO?.E1"V"
- FOR PSBI="IVTAB","PBTAB"
- DO RPC^PSBVDLTB(,PSBVDFN,PSBI,$GET(PSBVADT))
- MERGE ^TMP("PSBVPR",$JOB)=^TMP("PSB",$JOB,PSBI)
- +3 SET S1=0
- FOR
- SET S1=$ORDER(^TMP("PSBVPR",$JOB,S1))
- if 'S1
- QUIT
- Begin DoDot:1
- +4 SET A=^TMP("PSBVPR",$JOB,S1)
- IF $PIECE(A,"^")'=PSBVDFN
- QUIT
- +5 IF $PIECE(A,"^",2)'=PSBORDNO
- QUIT
- +6 SET PSBA($PIECE(A,"^",14))=""
- End DoDot:1
- +7 QUIT