- 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
