ABMDMDB2 ;IHS/ASDST/DMJ - MEDICARE B CLAIM SPLIT
;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
;
; IHS/SD/SDR - v2.5 p9 - IM16055
; Fixed global reference
;
START ;set start
S $P(^ABMDEXP(20,0),"^",8)=$P($G(^ABMDEXP(20,0)),"^",8)_",25,26"
S ^ABMQUES(25,0)="DATE LAST SEEN^W25^ABMDE30^25^ABMDE3C"
S ^ABMQUES(26,0)="SUPERVISING PROV UPIN^W26^ABMDE30^26^ABMDE3C"
S ^ABMQUES("B","DATE LAST SEEN",25)=""
S ^ABMQUES("B","SUPERVISING PROV UPIN",26)=""
Q:$G(^ABMCNVRT("MDB2","START"))
S ^ABMCNVRT("MDB2","START")=$H
ALL ;all sites
S ABMDUZ2=DUZ(2)
S DUZ(2)=0
F S DUZ(2)=$O(^ABMDCLM(DUZ(2))) Q:'DUZ(2) Q:DUZ(2)'=+DUZ(2) D
.D ONE
S DUZ(2)=ABMDUZ2
K ABMDUZ2
S ^ABMCNVRT("MDB2","STOP")=$H
Q
ONE ;one site
Q:$P($G(^ABMDPARM(DUZ(2),1,5)),U)
W !!,"Site= ",$P($G(^AUTTLOC(DUZ(2),0)),"^",2)
S ABMDT=3010700
F S ABMDT=$O(^ABMDCLM(DUZ(2),"AD",ABMDT)) Q:'ABMDT D
.S ABMCLM=0
.F S ABMCLM=$O(^ABMDCLM(DUZ(2),"AD",ABMDT,ABMCLM)) Q:'ABMCLM D
..D CLAIM
Q
CLAIM ;one claim
S ABMVTYP=+$P(^ABMDCLM(DUZ(2),ABMCLM,0),"^",7)
S ABMCLIN=+$P(^ABMDCLM(DUZ(2),ABMCLM,0),"^",6)
Q:ABMVTYP=999
Q:ABMVTYP=997
Q:ABMCLIN=39
S I=0,ABMCR=0
F S I=$O(^ABMDCLM(DUZ(2),ABMCLM,13,I)) Q:'I D
.S ABMINS=+$P(^ABMDCLM(DUZ(2),ABMCLM,13,I,0),U)
.Q:$P($G(^AUTNINS(ABMINS,2)),U)'="R"
.S ABMCR=ABMINS
Q:'ABMCR
S ABMCOV=0
S I=0
F S I=$O(^AUTTPIC("C",ABMCR,I)) Q:'I D
.Q:$P(^AUTTPIC(I,0),U)'["B"
.S ABMCOV=I
Q:$$UPRV^ABMDUTL(ABMCLM,ABMCOV)
Q:$D(^AUTNINS(ABMCR,17,"B",ABMCLIN))
Q:$D(^AUTTPIC(ABMCOV,11,ABMCLIN,0))
Q:$P($G(^ABMNINS(DUZ(2),ABMCR,1,ABMVTYP,0)),"^",7)="N"
S ABMPAT=$P(^ABMDCLM(DUZ(2),ABMCLM,0),U)
S ABMVDT=$P(^ABMDCLM(DUZ(2),ABMCLM,0),"^",2)
S I=0,ABMDB=0
F S I=$O(^ABMDCLM(DUZ(2),"B",ABMPAT,I)) Q:'I D
.Q:$P(^ABMDCLM(DUZ(2),I,0),"^",2)'=ABMVDT
.Q:$P(^ABMDCLM(DUZ(2),I,0),"^",7)'=999
.S ABMDB=1
Q:ABMDB
D MAIN^ABMDSPLB(ABMCLM)
W "."
Q
ABMDMDB2 ;IHS/ASDST/DMJ - MEDICARE B CLAIM SPLIT
+1 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
+2 ;
+3 ; IHS/SD/SDR - v2.5 p9 - IM16055
+4 ; Fixed global reference
+5 ;
START ;set start
+1 SET $PIECE(^ABMDEXP(20,0),"^",8)=$PIECE($GET(^ABMDEXP(20,0)),"^",8)_",25,26"
+2 SET ^ABMQUES(25,0)="DATE LAST SEEN^W25^ABMDE30^25^ABMDE3C"
+3 SET ^ABMQUES(26,0)="SUPERVISING PROV UPIN^W26^ABMDE30^26^ABMDE3C"
+4 SET ^ABMQUES("B","DATE LAST SEEN",25)=""
+5 SET ^ABMQUES("B","SUPERVISING PROV UPIN",26)=""
+6 IF $GET(^ABMCNVRT("MDB2","START"))
QUIT
+7 SET ^ABMCNVRT("MDB2","START")=$HOROLOG
ALL ;all sites
+1 SET ABMDUZ2=DUZ(2)
+2 SET DUZ(2)=0
+3 FOR
SET DUZ(2)=$ORDER(^ABMDCLM(DUZ(2)))
IF 'DUZ(2)
QUIT
IF DUZ(2)'=+DUZ(2)
QUIT
Begin DoDot:1
+4 DO ONE
End DoDot:1
+5 SET DUZ(2)=ABMDUZ2
+6 KILL ABMDUZ2
+7 SET ^ABMCNVRT("MDB2","STOP")=$HOROLOG
+8 QUIT
ONE ;one site
+1 IF $PIECE($GET(^ABMDPARM(DUZ(2),1,5)),U)
QUIT
+2 WRITE !!,"Site= ",$PIECE($GET(^AUTTLOC(DUZ(2),0)),"^",2)
+3 SET ABMDT=3010700
+4 FOR
SET ABMDT=$ORDER(^ABMDCLM(DUZ(2),"AD",ABMDT))
IF 'ABMDT
QUIT
Begin DoDot:1
+5 SET ABMCLM=0
+6 FOR
SET ABMCLM=$ORDER(^ABMDCLM(DUZ(2),"AD",ABMDT,ABMCLM))
IF 'ABMCLM
QUIT
Begin DoDot:2
+7 DO CLAIM
End DoDot:2
End DoDot:1
+8 QUIT
CLAIM ;one claim
+1 SET ABMVTYP=+$PIECE(^ABMDCLM(DUZ(2),ABMCLM,0),"^",7)
+2 SET ABMCLIN=+$PIECE(^ABMDCLM(DUZ(2),ABMCLM,0),"^",6)
+3 IF ABMVTYP=999
QUIT
+4 IF ABMVTYP=997
QUIT
+5 IF ABMCLIN=39
QUIT
+6 SET I=0
SET ABMCR=0
+7 FOR
SET I=$ORDER(^ABMDCLM(DUZ(2),ABMCLM,13,I))
IF 'I
QUIT
Begin DoDot:1
+8 SET ABMINS=+$PIECE(^ABMDCLM(DUZ(2),ABMCLM,13,I,0),U)
+9 IF $PIECE($GET(^AUTNINS(ABMINS,2)),U)'="R"
QUIT
+10 SET ABMCR=ABMINS
End DoDot:1
+11 IF 'ABMCR
QUIT
+12 SET ABMCOV=0
+13 SET I=0
+14 FOR
SET I=$ORDER(^AUTTPIC("C",ABMCR,I))
IF 'I
QUIT
Begin DoDot:1
+15 IF $PIECE(^AUTTPIC(I,0),U)'["B"
QUIT
+16 SET ABMCOV=I
End DoDot:1
+17 IF $$UPRV^ABMDUTL(ABMCLM,ABMCOV)
QUIT
+18 IF $DATA(^AUTNINS(ABMCR,17,"B",ABMCLIN))
QUIT
+19 IF $DATA(^AUTTPIC(ABMCOV,11,ABMCLIN,0))
QUIT
+20 IF $PIECE($GET(^ABMNINS(DUZ(2),ABMCR,1,ABMVTYP,0)),"^",7)="N"
QUIT
+21 SET ABMPAT=$PIECE(^ABMDCLM(DUZ(2),ABMCLM,0),U)
+22 SET ABMVDT=$PIECE(^ABMDCLM(DUZ(2),ABMCLM,0),"^",2)
+23 SET I=0
SET ABMDB=0
+24 FOR
SET I=$ORDER(^ABMDCLM(DUZ(2),"B",ABMPAT,I))
IF 'I
QUIT
Begin DoDot:1
+25 IF $PIECE(^ABMDCLM(DUZ(2),I,0),"^",2)'=ABMVDT
QUIT
+26 IF $PIECE(^ABMDCLM(DUZ(2),I,0),"^",7)'=999
QUIT
+27 SET ABMDB=1
End DoDot:1
+28 IF ABMDB
QUIT
+29 DO MAIN^ABMDSPLB(ABMCLM)
+30 WRITE "."
+31 QUIT
