- 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
