ABMCPOSS ; IHS/SD/SDR - Mark POS bill with invoice number ;
;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
;
; This routine will go thru POS Cashiering sessions and if the
; session is marked as transmitted it will verify there is an
; Invoice number on the bill and put one if not.
;
Q
EN ;
K ABMCNT
S DIC="^ABMUTXMT("
S DIC(0)="L"
D NOW^%DTC
S X=%
D ^DIC
K DIC
Q:Y<0
S ABMXIEN=+Y
S DUZ(2)=0
F S DUZ(2)=$O(^ABMUCASH(DUZ(2))) Q:+DUZ(2)=0 D
.W !,DUZ(2)
.S ABMSGNI=0
.F S ABMSGNI=$O(^ABMUCASH(DUZ(2),20,1,20,ABMSGNI)) Q:+ABMSGNI=0 D
..Q:$P($G(^ABMUCASH(DUZ(2),20,1,20,ABMSGNI,0)),U,4)'="T" ;check transmitted only
..S ABMBA=0
..F S ABMBA=$O(^ABMUCASH(DUZ(2),20,1,20,ABMSGNI,11,ABMBA)) Q:+ABMBA=0 D
...S ABMBILL=0
...F S ABMBILL=$O(^ABMUCASH(DUZ(2),20,1,20,ABMSGNI,11,ABMBA,2,ABMBILL)) Q:+ABMBILL=0 D
....S ABMREC=$G(^ABMUCASH(DUZ(2),20,1,20,ABMSGNI,11,ABMBA,2,ABMBILL,0))
....S ABMDUZ2=$P(ABMREC,U,2)
....S ABMBDFN=$P(ABMREC,U,3)
....I $$TRANSMIT^ABMUEAPI(ABMDUZ2,ABMBDFN)<1 D
.....D GETBILL^ABMUCUTL(ABMREC)
.....K DIC,DIE,DIR,X,Y,DA
.....S DIC(0)="L"
.....S DA(1)=ABMBDFN
.....;S X=$P($G(^ABMUCASH(DUZ(2),20,1,20,ABMSGNI,0)),U,8)
.....S X=ABMXIEN
.....S ABMHOLD=DUZ(2)
.....S DUZ(2)=ABMDUZ2
.....S DLAYGO=9002274
.....S DIC="^ABMDBILL(DUZ(2),"_DA(1)_",69,"
.....S DIC("P")=$P(^DD(9002274.4,69,0),U,2)
.....S DIC("DR")=".02////"_ABMPASUF_ABMSASUF_$S(+$G(ABMUAOF)'=0:$E($P($G(^DIC(4,ABMP("LDFN"),0)),U),1),1:"")_ABMP("BDFN")
.....D ^DIC
.....S DUZ(2)=ABMHOLD
.....W !,ABMREC_"^"_$G(DIC("DR"))_"^"_X_"^"_Y
.....S ABMCNT=+$G(ABMCNT)+1
W !,ABMCNT
D REGULAR
Q
REGULAR ;
K ABMCNT
S DUZ(2)=0
F S DUZ(2)=$O(^ABMUCASH(DUZ(2))) Q:+DUZ(2)=0 D
.W !,DUZ(2)
.S ABMUSER=0
.F S ABMUSER=$O(^ABMUCASH(DUZ(2),10,ABMUSER)) Q:+ABMUSER=0 D
..S ABMSGNI=0
..F S ABMSGNI=$O(^ABMUCASH(DUZ(2),10,ABMUSER,20,ABMSGNI)) Q:+ABMSGNI=0 D
...Q:$P($G(^ABMUCASH(DUZ(2),10,ABMUSER,20,ABMSGNI,0)),U,4)'="T" ;check transmitted only
...S ABMBA=0
...F S ABMBA=$O(^ABMUCASH(DUZ(2),10,ABMUSER,20,ABMSGNI,11,ABMBA)) Q:+ABMBA=0 D
....S ABMBILL=0
....F S ABMBILL=$O(^ABMUCASH(DUZ(2),10,ABMUSER,20,ABMSGNI,11,ABMBA,2,ABMBILL)) Q:+ABMBILL=0 D
.....S ABMREC=$G(^ABMUCASH(DUZ(2),10,ABMUSER,20,ABMSGNI,11,ABMBA,2,ABMBILL,0))
.....S ABMDUZ2=$P(ABMREC,U,2)
.....S ABMBDFN=$P(ABMREC,U,3)
.....I $$TRANSMIT^ABMUEAPI(ABMDUZ2,ABMBDFN)<1 D
......D GETBILL^ABMUCUTL(ABMREC)
......K DIC,DIE,DIR,X,Y,DA
......S DIC(0)="L"
......S DA(1)=ABMBDFN
......;S X=$P($G(^ABMUCASH(DUZ(2),10,1,20,ABMSGNI,0)),U,8)
......S X=ABMXIEN
......S ABMHOLD=DUZ(2)
......S DUZ(2)=ABMDUZ2
......S DLAYGO=9002274
......S DIC="^ABMDBILL(DUZ(2),"_DA(1)_",69,"
......S DIC("P")=$P(^DD(9002274.4,69,0),U,2)
......S DIC("DR")=".02////"_ABMPASUF_ABMSASUF_$S(+$G(ABMUAOF)'=0:$E($P($G(^DIC(4,ABMP("LDFN"),0)),U),1),1:"")_ABMP("BDFN")
......D ^DIC
......S DUZ(2)=ABMHOLD
......W !,ABMREC_"^"_$G(DIC("DR"))_"^"_X_"^"_Y
......S ABMCNT=+$G(ABMCNT)+1
W !,ABMCNT
Q
ABMCPOSS ; IHS/SD/SDR - Mark POS bill with invoice number ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
+2 ;
+3 ; This routine will go thru POS Cashiering sessions and if the
+4 ; session is marked as transmitted it will verify there is an
+5 ; Invoice number on the bill and put one if not.
+6 ;
+7 QUIT
EN ;
+1 KILL ABMCNT
+2 SET DIC="^ABMUTXMT("
+3 SET DIC(0)="L"
+4 DO NOW^%DTC
+5 SET X=%
+6 DO ^DIC
+7 KILL DIC
+8 IF Y<0
QUIT
+9 SET ABMXIEN=+Y
+10 SET DUZ(2)=0
+11 FOR
SET DUZ(2)=$ORDER(^ABMUCASH(DUZ(2)))
IF +DUZ(2)=0
QUIT
Begin DoDot:1
+12 WRITE !,DUZ(2)
+13 SET ABMSGNI=0
+14 FOR
SET ABMSGNI=$ORDER(^ABMUCASH(DUZ(2),20,1,20,ABMSGNI))
IF +ABMSGNI=0
QUIT
Begin DoDot:2
+15 ;check transmitted only
IF $PIECE($GET(^ABMUCASH(DUZ(2),20,1,20,ABMSGNI,0)),U,4)'="T"
QUIT
+16 SET ABMBA=0
+17 FOR
SET ABMBA=$ORDER(^ABMUCASH(DUZ(2),20,1,20,ABMSGNI,11,ABMBA))
IF +ABMBA=0
QUIT
Begin DoDot:3
+18 SET ABMBILL=0
+19 FOR
SET ABMBILL=$ORDER(^ABMUCASH(DUZ(2),20,1,20,ABMSGNI,11,ABMBA,2,ABMBILL))
IF +ABMBILL=0
QUIT
Begin DoDot:4
+20 SET ABMREC=$GET(^ABMUCASH(DUZ(2),20,1,20,ABMSGNI,11,ABMBA,2,ABMBILL,0))
+21 SET ABMDUZ2=$PIECE(ABMREC,U,2)
+22 SET ABMBDFN=$PIECE(ABMREC,U,3)
+23 IF $$TRANSMIT^ABMUEAPI(ABMDUZ2,ABMBDFN)<1
Begin DoDot:5
+24 DO GETBILL^ABMUCUTL(ABMREC)
+25 KILL DIC,DIE,DIR,X,Y,DA
+26 SET DIC(0)="L"
+27 SET DA(1)=ABMBDFN
+28 ;S X=$P($G(^ABMUCASH(DUZ(2),20,1,20,ABMSGNI,0)),U,8)
+29 SET X=ABMXIEN
+30 SET ABMHOLD=DUZ(2)
+31 SET DUZ(2)=ABMDUZ2
+32 SET DLAYGO=9002274
+33 SET DIC="^ABMDBILL(DUZ(2),"_DA(1)_",69,"
+34 SET DIC("P")=$PIECE(^DD(9002274.4,69,0),U,2)
+35 SET DIC("DR")=".02////"_ABMPASUF_ABMSASUF_$SELECT(+$GET(ABMUAOF)'=0:$EXTRACT($PIECE($GET(^DIC(4,ABMP("LDFN"),0)),U),1),1:"")_ABMP("BDFN")
+36 DO ^DIC
+37 SET DUZ(2)=ABMHOLD
+38 WRITE !,ABMREC_"^"_$GET(DIC("DR"))_"^"_X_"^"_Y
+39 SET ABMCNT=+$GET(ABMCNT)+1
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+40 WRITE !,ABMCNT
+41 DO REGULAR
+42 QUIT
REGULAR ;
+1 KILL ABMCNT
+2 SET DUZ(2)=0
+3 FOR
SET DUZ(2)=$ORDER(^ABMUCASH(DUZ(2)))
IF +DUZ(2)=0
QUIT
Begin DoDot:1
+4 WRITE !,DUZ(2)
+5 SET ABMUSER=0
+6 FOR
SET ABMUSER=$ORDER(^ABMUCASH(DUZ(2),10,ABMUSER))
IF +ABMUSER=0
QUIT
Begin DoDot:2
+7 SET ABMSGNI=0
+8 FOR
SET ABMSGNI=$ORDER(^ABMUCASH(DUZ(2),10,ABMUSER,20,ABMSGNI))
IF +ABMSGNI=0
QUIT
Begin DoDot:3
+9 ;check transmitted only
IF $PIECE($GET(^ABMUCASH(DUZ(2),10,ABMUSER,20,ABMSGNI,0)),U,4)'="T"
QUIT
+10 SET ABMBA=0
+11 FOR
SET ABMBA=$ORDER(^ABMUCASH(DUZ(2),10,ABMUSER,20,ABMSGNI,11,ABMBA))
IF +ABMBA=0
QUIT
Begin DoDot:4
+12 SET ABMBILL=0
+13 FOR
SET ABMBILL=$ORDER(^ABMUCASH(DUZ(2),10,ABMUSER,20,ABMSGNI,11,ABMBA,2,ABMBILL))
IF +ABMBILL=0
QUIT
Begin DoDot:5
+14 SET ABMREC=$GET(^ABMUCASH(DUZ(2),10,ABMUSER,20,ABMSGNI,11,ABMBA,2,ABMBILL,0))
+15 SET ABMDUZ2=$PIECE(ABMREC,U,2)
+16 SET ABMBDFN=$PIECE(ABMREC,U,3)
+17 IF $$TRANSMIT^ABMUEAPI(ABMDUZ2,ABMBDFN)<1
Begin DoDot:6
+18 DO GETBILL^ABMUCUTL(ABMREC)
+19 KILL DIC,DIE,DIR,X,Y,DA
+20 SET DIC(0)="L"
+21 SET DA(1)=ABMBDFN
+22 ;S X=$P($G(^ABMUCASH(DUZ(2),10,1,20,ABMSGNI,0)),U,8)
+23 SET X=ABMXIEN
+24 SET ABMHOLD=DUZ(2)
+25 SET DUZ(2)=ABMDUZ2
+26 SET DLAYGO=9002274
+27 SET DIC="^ABMDBILL(DUZ(2),"_DA(1)_",69,"
+28 SET DIC("P")=$PIECE(^DD(9002274.4,69,0),U,2)
+29 SET DIC("DR")=".02////"_ABMPASUF_ABMSASUF_$SELECT(+$GET(ABMUAOF)'=0:$EXTRACT($PIECE($GET(^DIC(4,ABMP("LDFN"),0)),U),1),1:"")_ABMP("BDFN")
+30 DO ^DIC
+31 SET DUZ(2)=ABMHOLD
+32 WRITE !,ABMREC_"^"_$GET(DIC("DR"))_"^"_X_"^"_Y
+33 SET ABMCNT=+$GET(ABMCNT)+1
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+34 WRITE !,ABMCNT
+35 QUIT
