- ABMUCUT2 ; IHS/SD/SDR - 3PB/UFMS Cashiering Utilities - Part 2
- ;;2.6;IHS Third Party Billing;**14,21**;NOV 12, 2009;Build 379
- ; New routine - abm*2.6*14
- ; Cashiering Utilities
- ;IHS/SD/SDR - 2.6*21 - HEAT121470 - Updated to use a new x-ref for session status. Taking
- ; too long to look through all sessions and causing <STORE>FINDACLS+22^ABMUCUTL
- ;
- FINDAOPN ;EP - look for all open sessions
- ; 0 returned means no open sessions found
- ; anything else is list of open sessions (ABMO(SESSION#,DUZ,SDT)
- ;
- K ABMO
- S ABMLOC=$$FINDLOC^ABMUCUTL ;what location to look under
- S ABMFD=0
- ;user entries
- ;S ABMUSER=0 ;abm*2.6*14 HEAT121470
- S ABMUSER=1 ;start at 1 to skip POS sess; ;abm*2.6*21 IHS/SD/SDR HEAT121470
- ;F S ABMUSER=$O(^ABMUCASH(ABMLOC,10,ABMUSER)) Q:+ABMUSER=0 D ;abm*2.6*21 IHS/SD/SDR HEAT121470
- F S ABMUSER=$O(^ABMUCASH(ABMLOC,"AC","O",ABMUSER)) Q:+ABMUSER=0 D ;abm*2.6*21 IHS/SD/SDR HEAT121470
- .S ABMSDT=0
- .;F S ABMSDT=$O(^ABMUCASH(ABMLOC,10,ABMUSER,20,ABMSDT)) Q:+ABMSDT=0 D Q:ABMFD'=0 ;abm*2.6*21 IHS/SD/SDR HEAT121470
- .F S ABMSDT=$O(^ABMUCASH(ABMLOC,"AC","O",ABMUSER,ABMSDT)) Q:+ABMSDT=0 D Q:ABMFD'=0 ;abm*2.6*21 IHS/SD/SDR HEAT121470
- ..I $P($G(^ABMUCASH(ABMLOC,10,ABMUSER,20,ABMSDT,0)),U,3)'="" Q
- ..S ABMO(ABMSDT,ABMUSER,ABMSDT)=""
- ..S ABMAFLG=$$ACTIVCK^ABMUUTL(ABMLOC,ABMSDT,ABMUSER) ;check for activity in session
- ..I +$G(ABMAFLG)'=0 S $P(ABMO(ABMSDT,ABMUSER,ABMSDT),U,3)=1
- ;look for POS entries
- ;start old abm*2.6*21 IHS/SD/SDR HEAT121470
- ;S ABMUSER=0
- ;F S ABMUSER=$O(^ABMUCASH(ABMLOC,20,ABMUSER)) Q:+ABMUSER=0 D
- ;.S ABMSDT=0
- ;.F S ABMSDT=$O(^ABMUCASH(ABMLOC,20,ABMUSER,20,ABMSDT)) Q:+ABMSDT=0 D Q:ABMFD'=0
- ;..I $P($G(^ABMUCASH(ABMLOC,20,ABMUSER,20,ABMSDT,0)),U,3)'="" Q
- ;..S ABMO(ABMSDT,"POS",ABMSDT)=""
- ;end old start new abm*2.6*21 IHS/SD/SDR HEAT121470
- S ABMSDT=0,ABMUSER=1
- F S ABMSDT=$O(^ABMUCASH(ABMLOC,"AC","O",1,ABMSDT)) Q:+ABMSDT=0 D Q:ABMFD'=0
- .I $P($G(^ABMUCASH(ABMLOC,20,ABMUSER,20,ABMSDT,0)),U,3)'="" Q
- .S ABMO(ABMSDT,"POS",ABMSDT)=""
- ;end new abm*2.6*21 IHS/SD/SDR HEAT121470
- Q
- FINDACLS ;EP - look for all closed sessions
- ; 0 returned means no closed sessions found
- ; anything else is list of closed sessions (ABMO(SESSION#,DUZ,SDT)
- ;
- K ABMO
- S ABMLOC=$$FINDLOC^ABMUCUTL ;what location to look under
- S ABMFD=0
- ;start old abm*2.6*21 IHS/SD/SDR HEAT121470
- ;S ABMDUZ=0
- ;F S ABMDUZ=$O(^ABMUCASH(ABMLOC,10,ABMDUZ)) Q:+ABMDUZ=0 D
- ;.S ABMSDT=0
- ;.F S ABMSDT=$O(^ABMUCASH(ABMLOC,10,ABMDUZ,20,ABMSDT)) Q:+ABMSDT=0 D Q:ABMFD'=0
- ;..I $P($G(^ABMUCASH(ABMLOC,10,ABMDUZ,20,ABMSDT,0)),U,3)="" Q
- ;..I $G(ABMFLG)="CLOSED",($P($G(^ABMUCASH(ABMLOC,10,ABMDUZ,20,ABMSDT,0)),U,4))'="C" Q
- ;..S ABMO(ABMSDT,ABMDUZ,ABMSDT)=$P($G(^ABMUCASH(ABMLOC,10,ABMDUZ,20,ABMSDT,0)),U,4)_"^"_$P($G(^ABMUCASH(ABMLOC,10,ABMDUZ,20,ABMSDT,0)),U,3)
- ;..S ABMAFLG=$$ACTIVCK^ABMUUTL(ABMLOC,ABMSDT,ABMDUZ) ;check for activity in session
- ;..I +$G(ABMAFLG)'=0 S $P(ABMO(ABMSDT,ABMDUZ,ABMSDT),U,3)=1
- ;;POS entries
- ;S ABMSDT=0
- ;F S ABMSDT=$O(^ABMUCASH(ABMLOC,20,1,20,ABMSDT)) Q:+ABMSDT=0 D Q:ABMFD'=0
- ;.I $P($G(^ABMUCASH(ABMLOC,20,1,20,ABMSDT,0)),U,3)="" Q
- ;.I $G(ABMFLG)="CLOSED",($P($G(^ABMUCASH(ABMLOC,20,1,20,ABMSDT,0)),U,4))'="C" Q
- ;.S ABMO(ABMSDT,"POS",ABMSDT)=$P($G(^ABMUCASH(ABMLOC,20,1,20,ABMSDT,0)),U,4)_"^"_$P($G(^ABMUCASH(ABMLOC,20,1,20,ABMSDT,0)),U,3)
- ;end old start new abm*2.6*21 IHS/SD/SDR HEAT121470
- S X1=DT
- S X2="-"_$P($G(^ABMDPARM(DUZ(2),1,4)),U,16) ;display number of days limit
- D C^%DTC
- S ABMDLIMT=X
- S ABMDUZ=1
- F ABMSTAT="C","T","R" D
- .F S ABMDUZ=$O(^ABMUCASH(ABMLOC,"AC",ABMSTAT,ABMDUZ)) Q:+ABMDUZ=0 D
- ..S ABMSDT=0
- ..F S ABMSDT=$O(^ABMUCASH(ABMLOC,"AC",ABMSTAT,ABMDUZ,ABMSDT)) Q:+ABMSDT=0 D Q:ABMFD'=0
- ...I $G(ABMSESSL)'="C" Q:ABMSDT<ABMDLIMT
- ...I $P($G(^ABMUCASH(ABMLOC,10,ABMDUZ,20,ABMSDT,0)),U,3)="" Q
- ...I $G(ABMFLG)="CLOSED",($P($G(^ABMUCASH(ABMLOC,10,ABMDUZ,20,ABMSDT,0)),U,4))'="C" Q
- ...S ABMO(ABMSDT,ABMDUZ,ABMSDT)=$P($G(^ABMUCASH(ABMLOC,10,ABMDUZ,20,ABMSDT,0)),U,4)_"^"_$P($G(^ABMUCASH(ABMLOC,10,ABMDUZ,20,ABMSDT,0)),U,3)
- ...S ABMAFLG=$$ACTIVCK^ABMUUTL(ABMLOC,ABMSDT,ABMDUZ) ;check for activity in session
- ...I +$G(ABMAFLG)'=0 S $P(ABMO(ABMSDT,ABMDUZ,ABMSDT),U,3)=1
- ;POS entries
- F ABMSTAT="C","T","R" D
- .S ABMSDT=0
- .F S ABMSDT=$O(^ABMUCASH(ABMLOC,"AC",ABMSTAT,1,ABMSDT)) Q:+ABMSDT=0 D Q:ABMFD'=0
- ..I $G(ABMSESSL)'="C" Q:ABMSDT<ABMDLIMT
- ..I $P($G(^ABMUCASH(ABMLOC,20,1,20,ABMSDT,0)),U,3)="" Q
- ..I $G(ABMFLG)="CLOSED",($P($G(^ABMUCASH(ABMLOC,20,1,20,ABMSDT,0)),U,4))'="C" Q
- ..S ABMO(ABMSDT,"POS",ABMSDT)=$P($G(^ABMUCASH(ABMLOC,20,1,20,ABMSDT,0)),U,4)_"^"_$P($G(^ABMUCASH(ABMLOC,20,1,20,ABMSDT,0)),U,3)
- ;end new abm*2.6*21 IHS/SD/SDR HEAT121470
- Q
- ABMUCUT2 ; IHS/SD/SDR - 3PB/UFMS Cashiering Utilities - Part 2
- +1 ;;2.6;IHS Third Party Billing;**14,21**;NOV 12, 2009;Build 379
- +2 ; New routine - abm*2.6*14
- +3 ; Cashiering Utilities
- +4 ;IHS/SD/SDR - 2.6*21 - HEAT121470 - Updated to use a new x-ref for session status. Taking
- +5 ; too long to look through all sessions and causing <STORE>FINDACLS+22^ABMUCUTL
- +6 ;
- FINDAOPN ;EP - look for all open sessions
- +1 ; 0 returned means no open sessions found
- +2 ; anything else is list of open sessions (ABMO(SESSION#,DUZ,SDT)
- +3 ;
- +4 KILL ABMO
- +5 ;what location to look under
- SET ABMLOC=$$FINDLOC^ABMUCUTL
- +6 SET ABMFD=0
- +7 ;user entries
- +8 ;S ABMUSER=0 ;abm*2.6*14 HEAT121470
- +9 ;start at 1 to skip POS sess; ;abm*2.6*21 IHS/SD/SDR HEAT121470
- SET ABMUSER=1
- +10 ;F S ABMUSER=$O(^ABMUCASH(ABMLOC,10,ABMUSER)) Q:+ABMUSER=0 D ;abm*2.6*21 IHS/SD/SDR HEAT121470
- +11 ;abm*2.6*21 IHS/SD/SDR HEAT121470
- FOR
- SET ABMUSER=$ORDER(^ABMUCASH(ABMLOC,"AC","O",ABMUSER))
- IF +ABMUSER=0
- QUIT
- Begin DoDot:1
- +12 SET ABMSDT=0
- +13 ;F S ABMSDT=$O(^ABMUCASH(ABMLOC,10,ABMUSER,20,ABMSDT)) Q:+ABMSDT=0 D Q:ABMFD'=0 ;abm*2.6*21 IHS/SD/SDR HEAT121470
- +14 ;abm*2.6*21 IHS/SD/SDR HEAT121470
- FOR
- SET ABMSDT=$ORDER(^ABMUCASH(ABMLOC,"AC","O",ABMUSER,ABMSDT))
- IF +ABMSDT=0
- QUIT
- Begin DoDot:2
- +15 IF $PIECE($GET(^ABMUCASH(ABMLOC,10,ABMUSER,20,ABMSDT,0)),U,3)'=""
- QUIT
- +16 SET ABMO(ABMSDT,ABMUSER,ABMSDT)=""
- +17 ;check for activity in session
- SET ABMAFLG=$$ACTIVCK^ABMUUTL(ABMLOC,ABMSDT,ABMUSER)
- +18 IF +$GET(ABMAFLG)'=0
- SET $PIECE(ABMO(ABMSDT,ABMUSER,ABMSDT),U,3)=1
- End DoDot:2
- IF ABMFD'=0
- QUIT
- End DoDot:1
- +19 ;look for POS entries
- +20 ;start old abm*2.6*21 IHS/SD/SDR HEAT121470
- +21 ;S ABMUSER=0
- +22 ;F S ABMUSER=$O(^ABMUCASH(ABMLOC,20,ABMUSER)) Q:+ABMUSER=0 D
- +23 ;.S ABMSDT=0
- +24 ;.F S ABMSDT=$O(^ABMUCASH(ABMLOC,20,ABMUSER,20,ABMSDT)) Q:+ABMSDT=0 D Q:ABMFD'=0
- +25 ;..I $P($G(^ABMUCASH(ABMLOC,20,ABMUSER,20,ABMSDT,0)),U,3)'="" Q
- +26 ;..S ABMO(ABMSDT,"POS",ABMSDT)=""
- +27 ;end old start new abm*2.6*21 IHS/SD/SDR HEAT121470
- +28 SET ABMSDT=0
- SET ABMUSER=1
- +29 FOR
- SET ABMSDT=$ORDER(^ABMUCASH(ABMLOC,"AC","O",1,ABMSDT))
- IF +ABMSDT=0
- QUIT
- Begin DoDot:1
- +30 IF $PIECE($GET(^ABMUCASH(ABMLOC,20,ABMUSER,20,ABMSDT,0)),U,3)'=""
- QUIT
- +31 SET ABMO(ABMSDT,"POS",ABMSDT)=""
- End DoDot:1
- IF ABMFD'=0
- QUIT
- +32 ;end new abm*2.6*21 IHS/SD/SDR HEAT121470
- +33 QUIT
- FINDACLS ;EP - look for all closed sessions
- +1 ; 0 returned means no closed sessions found
- +2 ; anything else is list of closed sessions (ABMO(SESSION#,DUZ,SDT)
- +3 ;
- +4 KILL ABMO
- +5 ;what location to look under
- SET ABMLOC=$$FINDLOC^ABMUCUTL
- +6 SET ABMFD=0
- +7 ;start old abm*2.6*21 IHS/SD/SDR HEAT121470
- +8 ;S ABMDUZ=0
- +9 ;F S ABMDUZ=$O(^ABMUCASH(ABMLOC,10,ABMDUZ)) Q:+ABMDUZ=0 D
- +10 ;.S ABMSDT=0
- +11 ;.F S ABMSDT=$O(^ABMUCASH(ABMLOC,10,ABMDUZ,20,ABMSDT)) Q:+ABMSDT=0 D Q:ABMFD'=0
- +12 ;..I $P($G(^ABMUCASH(ABMLOC,10,ABMDUZ,20,ABMSDT,0)),U,3)="" Q
- +13 ;..I $G(ABMFLG)="CLOSED",($P($G(^ABMUCASH(ABMLOC,10,ABMDUZ,20,ABMSDT,0)),U,4))'="C" Q
- +14 ;..S ABMO(ABMSDT,ABMDUZ,ABMSDT)=$P($G(^ABMUCASH(ABMLOC,10,ABMDUZ,20,ABMSDT,0)),U,4)_"^"_$P($G(^ABMUCASH(ABMLOC,10,ABMDUZ,20,ABMSDT,0)),U,3)
- +15 ;..S ABMAFLG=$$ACTIVCK^ABMUUTL(ABMLOC,ABMSDT,ABMDUZ) ;check for activity in session
- +16 ;..I +$G(ABMAFLG)'=0 S $P(ABMO(ABMSDT,ABMDUZ,ABMSDT),U,3)=1
- +17 ;;POS entries
- +18 ;S ABMSDT=0
- +19 ;F S ABMSDT=$O(^ABMUCASH(ABMLOC,20,1,20,ABMSDT)) Q:+ABMSDT=0 D Q:ABMFD'=0
- +20 ;.I $P($G(^ABMUCASH(ABMLOC,20,1,20,ABMSDT,0)),U,3)="" Q
- +21 ;.I $G(ABMFLG)="CLOSED",($P($G(^ABMUCASH(ABMLOC,20,1,20,ABMSDT,0)),U,4))'="C" Q
- +22 ;.S ABMO(ABMSDT,"POS",ABMSDT)=$P($G(^ABMUCASH(ABMLOC,20,1,20,ABMSDT,0)),U,4)_"^"_$P($G(^ABMUCASH(ABMLOC,20,1,20,ABMSDT,0)),U,3)
- +23 ;end old start new abm*2.6*21 IHS/SD/SDR HEAT121470
- +24 SET X1=DT
- +25 ;display number of days limit
- SET X2="-"_$PIECE($GET(^ABMDPARM(DUZ(2),1,4)),U,16)
- +26 DO C^%DTC
- +27 SET ABMDLIMT=X
- +28 SET ABMDUZ=1
- +29 FOR ABMSTAT="C","T","R"
- Begin DoDot:1
- +30 FOR
- SET ABMDUZ=$ORDER(^ABMUCASH(ABMLOC,"AC",ABMSTAT,ABMDUZ))
- IF +ABMDUZ=0
- QUIT
- Begin DoDot:2
- +31 SET ABMSDT=0
- +32 FOR
- SET ABMSDT=$ORDER(^ABMUCASH(ABMLOC,"AC",ABMSTAT,ABMDUZ,ABMSDT))
- IF +ABMSDT=0
- QUIT
- Begin DoDot:3
- +33 IF $GET(ABMSESSL)'="C"
- IF ABMSDT<ABMDLIMT
- QUIT
- +34 IF $PIECE($GET(^ABMUCASH(ABMLOC,10,ABMDUZ,20,ABMSDT,0)),U,3)=""
- QUIT
- +35 IF $GET(ABMFLG)="CLOSED"
- IF ($PIECE($GET(^ABMUCASH(ABMLOC,10,ABMDUZ,20,ABMSDT,0)),U,4))'="C"
- QUIT
- +36 SET ABMO(ABMSDT,ABMDUZ,ABMSDT)=$PIECE($GET(^ABMUCASH(ABMLOC,10,ABMDUZ,20,ABMSDT,0)),U,4)_"^"_$PIECE($GET(^ABMUCASH(ABMLOC,10,ABMDUZ,20,ABMSDT,0)),U,3)
- +37 ;check for activity in session
- SET ABMAFLG=$$ACTIVCK^ABMUUTL(ABMLOC,ABMSDT,ABMDUZ)
- +38 IF +$GET(ABMAFLG)'=0
- SET $PIECE(ABMO(ABMSDT,ABMDUZ,ABMSDT),U,3)=1
- End DoDot:3
- IF ABMFD'=0
- QUIT
- End DoDot:2
- End DoDot:1
- +39 ;POS entries
- +40 FOR ABMSTAT="C","T","R"
- Begin DoDot:1
- +41 SET ABMSDT=0
- +42 FOR
- SET ABMSDT=$ORDER(^ABMUCASH(ABMLOC,"AC",ABMSTAT,1,ABMSDT))
- IF +ABMSDT=0
- QUIT
- Begin DoDot:2
- +43 IF $GET(ABMSESSL)'="C"
- IF ABMSDT<ABMDLIMT
- QUIT
- +44 IF $PIECE($GET(^ABMUCASH(ABMLOC,20,1,20,ABMSDT,0)),U,3)=""
- QUIT
- +45 IF $GET(ABMFLG)="CLOSED"
- IF ($PIECE($GET(^ABMUCASH(ABMLOC,20,1,20,ABMSDT,0)),U,4))'="C"
- QUIT
- +46 SET ABMO(ABMSDT,"POS",ABMSDT)=$PIECE($GET(^ABMUCASH(ABMLOC,20,1,20,ABMSDT,0)),U,4)_"^"_$PIECE($GET(^ABMUCASH(ABMLOC,20,1,20,ABMSDT,0)),U,3)
- End DoDot:2
- IF ABMFD'=0
- QUIT
- End DoDot:1
- +47 ;end new abm*2.6*21 IHS/SD/SDR HEAT121470
- +48 QUIT
