- ABSPOSRU ;IHS/OIT/SCR - Utilities for POS Insurance Report ;
- ;;1.0;PHARMACY POINT OF SALE;**38,46,50**;JUN 01, 2001 ;Build 38
- ;;BASED ON FILE ABMRMCRD - 2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
- Q
- MEDICARE(ABSPLIST,ABSPELDT,ABSPDEAD,ABSPCNT,ABSPTOT,ABSPPHRM) ; EP From ABSPOSR7
- N ABSPEN,ABSPEIEN,ABSPCOV,ABSPQUIT,ABSPSDT,ABSPEDT,ABSPHRN,ABSPNAM,ABSPHRNS,ABSPPIEN,ABSPHRNN,ABSPOUT
- N ABSPPN,ABSPDPT,ABSPHRL,ABSPPAT
- S ABSPEN=0,ABSPQUIT=0
- F S ABSPEN=$O(^AUPNMCR(ABSPEN)) Q:+ABSPEN=0 D
- .S ABSPDPT=$P(^AUPNMCR(ABSPEN,0),U,1)
- .Q:$G(^DPT(ABSPDPT,0))="" ;Still have to look out for that...
- .I $D(^DPT(ABSPDPT,.35)),$P(^(.35),U,1)]"",$P(^(.35),U,1)<ABSPELDT Q
- .S ABSPEIEN=0
- .F S ABSPEIEN=$O(^AUPNMCR(ABSPEN,11,ABSPEIEN)) Q:+ABSPEIEN=0 D
- ..S ABSPCOV=$P($G(^AUPNMCR(ABSPEN,11,ABSPEIEN,0)),U,3) ;coverage type
- ..Q:ABSPCOV'="D"
- ..S ABSPPIEN=$P($G(^AUPNMCR(ABSPEN,11,ABSPEIEN,0)),U,4) ; plan name (pointer to ins file)
- ..I ($G(ABSPPIEN)="") S ABSPQUIT=1 Q
- ..I ($G(ABSPLIST(ABSPPIEN))="") S ABSPQUIT=1 Q ;no entry for insurer on requested list
- ..I ABSPDEAD=0,($P($G(^DPT(ABSPEN,.35)),U)'="") S ABSPQUIT=1 Q ;check exclude flag and DOD
- ..S ABSPSDT=$P($G(^AUPNMCR(ABSPEN,11,ABSPEIEN,0)),U) ;ELIG START DATE
- ..S ABSPEDT=$P($G(^AUPNMCR(ABSPEN,11,ABSPEIEN,0)),U,2) ;ELIG END DATE
- ..I (ABSPSDT<=ABSPELDT)&((ABSPEDT>ABSPELDT)!(ABSPEDT="")) D
- ...S ABSPHRN=0
- ...F S ABSPHRN=$O(^AUPNPAT(ABSPEN,41,ABSPHRN)) Q:+ABSPHRN=0 D
- ....S ABSPHRL=$P($G(^AUPNPAT(ABSPEN,41,ABSPHRN,0)),U,1) ;location?
- ....Q:ABSPHRL=""
- ....;now look in ABSPPHRM array to see if this location is one that we are interested in...
- ....S ABSPPHRM=""
- ....F S ABSPPHRM=$O(ABSPPHRM(ABSPPHRM)) Q:ABSPPHRM="" D
- .....S ABSPOUT=""
- .....F S ABSPOUT=$O(ABSPPHRM(ABSPPHRM,ABSPOUT)) Q:ABSPOUT="" D
- ......;Q:$P(ABSPPHRM(ABSPPHRM,ABSPOUT),U,2)'=ABSPHRL ;add info about this patient when we find a pharmacy/outpatient match
- ......Q:ABSPOUT'=ABSPHRL ;add info about this patient when we find a pharmacy/outpatient match
- ......S ABSPHRNS=$P($G(^AUPNPAT(ABSPEN,41,ABSPHRN,0)),U,5) ;inactive?
- ......I (ABSPDEAD=0&ABSPHRN)="I" S ABSPQUIT=1 Q ;check exclude inactive flag and status
- ......S ABSPPNAM=$P(ABSPPHRM(ABSPPHRM,ABSPOUT),U,1)
- ......Q:ABSPPNAM=""
- ......;S ABSPPHRM(ABSPPHRM,ABSPHRL)=ABSPPNAM
- ......S ABSPNAM=$P($G(^AUTNINS(ABSPPIEN,0)),U) ;insurer name
- ......; S ABSPPN=$P($G(^AUPNMCR(ABSPEN,11,ABSPEIEN,0)),U,6) ;ID
- ......S ABSPPN=$$GETMCR^AGUTL(ABSPEN,ABSPELDT) ;ID ; /IHS/OIT/RAM ; 18 DEC 17 ; new method of retrieving MCRE number / MBI.
- ......S ABSPHRNN=$P($G(^AUPNPAT(ABSPEN,41,ABSPHRN,0)),U,2) ;HRN
- ......S ABSPPAT(ABSPHRNN)=$G(ABSPPAT(ABSPHRNN))+1 ;count the number of times we use this patient hrn
- ......S ABSPDPT(ABSPDPT)=$G(ABSPDPT(ABSPDPT))+1 ;count the number of times we use this patient DPT
- ......S ^TMP($J,"ABSPOSR7",ABSPPHRM,ABSPHRL,ABSPPIEN,ABSPDPT)=ABSPHRNN_U_ABSPSDT_U_ABSPEDT_U_ABSPPN
- ......S ABSPCNT(ABSPPHRM,ABSPHRL,ABSPNAM,ABSPPIEN)=$G(ABSPCNT(ABSPPHRM,ABSPHRL,ABSPNAM,ABSPPIEN))+1
- ......S ABSPTOT(ABSPPHRM,ABSPHRL,"TOTAL")=$G(ABSPTOT(ABSPPHRM,ABSPHRL,"TOTAL"))+1
- ......S:($G(ABSPPAT(ABSPHRNN))=1) ABSPTOT(ABSPPHRM,"TOTAL")=$G(ABSPTOT(ABSPPHRM,"TOTAL"))+1
- ......S:($G(ABSPDPT(ABSPDPT))=1) ABSPTOT("TOTAL")=$G(ABSPTOT("TOTAL"))+1
- Q
- ;
- PRIVATE(ABSPLIST,ABSPELDT,ABSPDEAD,ABSPCNT,ABSPTOT,ABSPPHRM) ; EP FROM ABSPOSR7
- N ABSPTIEN,ABSPEN,ABSPNS,ABSPSDT,ABSPEDT,ABSPHRN,ABSPHRNS,ABSPNAM,ABSPHRNN,ABSPPN,ABSPHRL,ABSPOUT
- S ABSPTIEN=0
- F S ABSPTIEN=$O(^AUPNPRVT(ABSPTIEN)) Q:+ABSPTIEN=0 D
- .S ABSPEN=0
- .F S ABSPEN=$O(^AUPNPRVT(ABSPTIEN,11,ABSPEN)) Q:+ABSPEN=0 D
- ..S ABSPNS=$P($G(^AUPNPRVT(ABSPTIEN,11,ABSPEN,0)),U)
- ..Q:$G(ABSPLIST(ABSPNS))="" ;not on list
- ..S ABSPSDT=$P($G(^AUPNPRVT(ABSPTIEN,11,ABSPEN,0)),U,6)
- ..S ABSPEDT=$P($G(^AUPNPRVT(ABSPTIEN,11,ABSPEN,0)),U,7)
- ..I ((ABSPSDT=ABSPELDT)!(ABSPSDT<ABSPELDT)),((ABSPEDT>ABSPELDT)!(ABSPEDT="")) D ;inside date range
- ...S ABSPHRN=0
- ...F S ABSPHRN=$O(^AUPNPAT(ABSPTIEN,41,ABSPHRN)) Q:+ABSPHRN=0 D
- ....S ABSPHRL=$P($G(^AUPNPAT(ABSPEN,41,ABSPHRN,0)),U,1) ;location?
- ....Q:ABSPHRL=""
- ....S ABSPPHRM=""
- ....;now look in ABSPPHRM array to see if this location is one that we are interested in...
- ....F S ABSPPHRM=$O(ABSPPHRM(ABSPPHRM)) Q:ABSPPHRM="" D
- .....S ABSPOUT=""
- .....N ABSPPAT
- .....F S ABSPOUT=$O(ABSPPHRM(ABSPPHRM,ABSPOUT)) Q:ABSPOUT="" D
- ......;Q:$P(ABSPPHRM(ABSPPHRM,ABSPOUT),U,2)'=ABSPHRL ;add info about this patient when we find a pharmacy/outpatient match
- ......Q:ABSPOUT'=ABSPHRL ;add info about this patient when we find a pharmacy/outpatient match
- ......S ABSPHRNS=$P($G(^AUPNPAT(ABSPTIEN,41,ABSPHRN,0)),U,5) ;inactive?
- ......I ABSPDEAD=0,ABSPHRNS="I" Q ;check exclude inactive flag and status
- ......S ABSPPNAM=$P(ABSPPHRM(ABSPPHRM,ABSPOUT),U,1)
- ......Q:ABSPPNAM=""
- ......;S ABSPPHRM(ABSPPHRM,ABSPHRL)=ABSPPNAM
- ......S ABSPNAM=$P($G(^AUTNINS(ABSPNS,0)),U) ;insurer name
- ......S:$P($G(^AUPNPRVT(ABSPTIEN,11,ABSPEN,0)),U,8)'="" ABSPPN=$P($G(^AUPN3PPH($P($G(^AUPNPRVT(ABSPTIEN,11,ABSPEN,0)),U,8),0)),U,4)
- ......S ABSPHRNN=$P($G(^AUPNPAT(ABSPTIEN,41,ABSPHRN,0)),U,2) ;HRN
- ......S:ABSPHRNN="" ABSPHRNN="NONE"
- ......S ABSPPAT(ABSPHRNN)=$G(ABSPPAT(ABSPHRNN))+1 ;count the number of times we use this patient hrn
- ......S ABSPDPT(ABSPTIEN)=$G(ABSPDPT(ABSPTIEN))+1 ;count the number of times we use this patient IEN
- ......S ^TMP($J,"ABSPOSR7",ABSPPHRM,ABSPHRL,ABSPNS,ABSPTIEN)=ABSPHRNN_U_ABSPSDT_U_ABSPEDT_U_ABSPPN
- ......S ABSPCNT(ABSPPHRM,ABSPHRL,ABSPNAM,ABSPNS)=+$G(ABSPCNT(ABSPPHRM,ABSPHRL,ABSPNAM,ABSPNS))+1
- ......S ABSPTOT(ABSPPHRM,ABSPHRL,"TOTAL")=$G(ABSPTOT(ABSPPHRM,ABSPHRL,"TOTAL"))+1
- ......S ABSPTOT(ABSPPHRM,"TOTAL")=$G(ABSPTOT(ABSPPHRM,"TOTAL"))+1
- ......S:($G(ABSPPAT(ABSPHRNN))=1) ABSPTOT(ABSPPHRM,"TOTAL")=$G(ABSPTOT(ABSPPHRM,"TOTAL"))+1
- ......S:($G(ABSPDPT(ABSPTIEN))=1) ABSPTOT("TOTAL")=$G(ABSPTOT("TOTAL"))+1
- Q
- ;
- MEDICAID(ABSPLIST,ABSPELDT,ABSPDEAD,ABSPCNT,ABSPTOT,ABSPPHRM) ;EP FROM ABSPOSR7
- N ABSPEN,ABSPEIEN,ABSPCOV,ABSPQUIT,ABSPSDT,ABSPEDT,ABSPHRN,ABSPNAM,ABSPHRNS,ABSPINSN,ABSPHRNN,ABSPPN
- N ABSPPIEN,ABSPPN,ABSPDPT,ABSPHRL,ABSPPAT,ABSPFND,ABSPINSP,ABSPMFI,ABSPSTP,ABSPOUT
- S ABSPEN=0,ABSPQUIT=0
- F S ABSPEN=$O(^AUPNMCD(ABSPEN)) Q:+ABSPEN=0 D
- .S ABSPDPT=$P(^AUPNMCD(ABSPEN,0),U,1)
- .Q:$G(^DPT(ABSPDPT,0))="" ;Still have to look out for that...
- .I $D(^DPT(ABSPDPT,.35)),$P(^(.35),U,1)]"",$P(^(.35),U,1)<ABSPELDT Q
- .Q:$G(^AUPNMCD(ABSPEN,0))="" ;Why would this happen?
- .S ABSPINSP=$P(^AUPNMCD(ABSPEN,0),U,2) ;POINTER TO INSURER FILE
- .I $P($G(^AUTNINS(ABSPINSP,0)),U,1)="MEDICAID" D
- ..S ABSPSTP=$P($G(^AUPNMCD(ABSPEN,0)),U,4) ;pointer to the state file
- ..S ABSPMFI=""
- ..S ABSPFND=0
- ..F S ABSPMFI=$O(^AUTNINS(ABSPINSP,13,ABSPMFI)) Q:(ABSPMFI="")!ABSPFND D
- ...I $P($G(^AUTNINS(ABSPINSP,13,ABSPMFI,0)),U,1)=ABSPSTP D
- ....S ABSPPIEN=$P($G(^AUTNINS(ABSPINSP,13,ABSPMFI,0)),U,2)
- ....S ABSPFND=1
- .S ABSPEIEN=0
- .F S ABSPEIEN=$O(^AUPNMCD(ABSPEN,11,ABSPEIEN)) Q:+ABSPEIEN=0 D
- ..I ($G(ABSPPIEN)="") S ABSPQUIT=1 Q
- ..I ($G(ABSPLIST(ABSPPIEN))="") S ABSPQUIT=1 Q ;no entry for insurer on requested list
- ..I ABSPDEAD=0,($P($G(^DPT(ABSPEN,.35)),U)'="") S ABSPQUIT=1 Q ;check exclude flag and DOD
- ..S ABSPSDT=$P($G(^AUPNMCD(ABSPEN,11,ABSPEIEN,0)),U) ;ELIG START DATE
- ..S ABSPEDT=$P($G(^AUPNMCD(ABSPEN,11,ABSPEIEN,0)),U,2) ;ELIG END DATE
- ..Q:ABSPSDT=""
- ..I (ABSPSDT<=ABSPELDT)&((ABSPEDT>ABSPELDT)!(ABSPEDT="")) D
- ...S ABSPHRN=0
- ...F S ABSPHRN=$O(^AUPNPAT(ABSPEN,41,ABSPHRN)) Q:+ABSPHRN=0 D
- ....S ABSPHRL=$P($G(^AUPNPAT(ABSPEN,41,ABSPHRN,0)),U,1) ;location?
- ....Q:ABSPHRL=""
- ....S ABSPPHRM=""
- ....;now look in ABSPPHRM array to see if this location is one that we are interested in...
- ....F S ABSPPHRM=$O(ABSPPHRM(ABSPPHRM)) Q:ABSPPHRM="" D
- .....S ABSPOUT=""
- .....F S ABSPOUT=$O(ABSPPHRM(ABSPPHRM,ABSPOUT)) Q:ABSPOUT="" D
- ......;Q:$P(ABSPPHRM(ABSPPHRM,ABSPOUT),U,2)'=ABSPHRL ;add info about this patient when we find a pharmacy/outpatient match
- ......Q:ABSPOUT'=ABSPHRL ;add info about this patient when we find a pharmacy/outpatient match
- ......S ABSPHRNS=$P($G(^AUPNPAT(ABSPEN,41,ABSPHRN,0)),U,5) ;inactive?
- ......I (ABSPDEAD=0&ABSPHRN)="I" S ABSPQUIT=1 Q ;check exclude inactive flag and status
- ......S ABSPPNAM=$P(ABSPPHRM(ABSPPHRM,ABSPOUT),U,1)
- ......Q:ABSPPNAM=""
- ......S ABSPNAM=$P($G(^AUTNINS(ABSPPIEN,0)),U) ;insurer name
- ......S ABSPPN=$P($G(^AUPNMCD(ABSPEN,0)),U,3) ;ID
- ......S ABSPHRNN=$P($G(^AUPNPAT(ABSPEN,41,ABSPHRN,0)),U,2) ;HRN
- ......S ABSPPAT(ABSPHRNN)=$G(ABSPPAT(ABSPHRNN))+1 ;count the number of times we use this patient hrn
- ......S ABSPDPT(ABSPDPT)=$G(ABSPDPT(ABSPDPT))+1 ;count the number of times we use this patient DPT
- ......S ^TMP($J,"ABSPOSR7",ABSPPHRM,ABSPHRL,ABSPPIEN,ABSPDPT)=ABSPHRNN_U_ABSPSDT_U_ABSPEDT_U_ABSPPN
- ......S ABSPCNT(ABSPPHRM,ABSPHRL,ABSPNAM,ABSPPIEN)=+$G(ABSPCNT(ABSPPHRM,ABSPHRL,ABSPNAM,ABSPPIEN))+1
- ......S ABSPTOT(ABSPPHRM,ABSPHRL,"TOTAL")=+$G(ABSPTOT(ABSPPHRM,ABSPHRL,"TOTAL"))+1
- ......S:($G(ABSPPAT(ABSPHRNN))=1) ABSPTOT(ABSPPHRM,"TOTAL")=$G(ABSPTOT(ABSPPHRM,"TOTAL"))+1
- ......S:($G(ABSPDPT(ABSPDPT))=1) ABSPTOT("TOTAL")=$G(ABSPTOT("TOTAL"))+1
- Q
- ;
- ;OIT/CAS/RCS 091213 Patch 46 Move subroutines
- BDT() ;ENTER BEGINING DATE
- N ABSPBDT,DIR,X1,X
- W !
- K DIR
- S DIR(0)="DEX"
- S DIR("A")="Enter Beginning Prescription Release Date"
- D ^DIR
- I $D(DIRUT) Q -1
- S ABSPBDT=+Y
- S X1=ABSPBDT D C^%DTC
- Q X
- EDT() ;ENTER END DATE
- N ABSPEDT,DIR,X1,X
- W !
- K DIR
- S DIR(0)="DEX"
- S DIR("A")="Enter Ending Prescription Release Date"
- D ^DIR
- I $D(DIRUT) Q -1
- S ABSPEDT=+Y
- S X1=ABSPEDT D C^%DTC
- Q X
- CLNC() ; PICK WHICH OR ALL CLINIC PHARMACIES
- N DIC,X,Y
- S DIC="^ABSP(9002313.56,"
- S DIC(0)="AEMQVZ"
- S DIC("A")="Please Select a Pharmacy or leave blank for ALL: "
- D ^DIC K DIC
- I X[U Q -1
- I Y=-1 S ABSPPPHM="ALL"
- I Y>-1 S ABSPPPHM=$P(Y,U,1),ABSPPHMN=$P(Y,U,2)
- Q 1
- DEVSEL ; SELECT DEVICE
- N ABSPSTOP
- S ABSPSTOP=0
- D ^%ZIS
- I POP D
- .D ^%ZIS
- .Q
- I $D(DUOUT) D
- .D ZEND^ABSPOSRZ
- .S ABSPSTOP=1
- .Q
- Q:ABSPSTOP
- I POP D
- .W "DEVICE UNAVAILABLE" G DEVSEL
- Q
- ABSPOSRU ;IHS/OIT/SCR - Utilities for POS Insurance Report ;
- +1 ;;1.0;PHARMACY POINT OF SALE;**38,46,50**;JUN 01, 2001 ;Build 38
- +2 ;;BASED ON FILE ABMRMCRD - 2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
- +3 QUIT
- MEDICARE(ABSPLIST,ABSPELDT,ABSPDEAD,ABSPCNT,ABSPTOT,ABSPPHRM) ; EP From ABSPOSR7
- +1 NEW ABSPEN,ABSPEIEN,ABSPCOV,ABSPQUIT,ABSPSDT,ABSPEDT,ABSPHRN,ABSPNAM,ABSPHRNS,ABSPPIEN,ABSPHRNN,ABSPOUT
- +2 NEW ABSPPN,ABSPDPT,ABSPHRL,ABSPPAT
- +3 SET ABSPEN=0
- SET ABSPQUIT=0
- +4 FOR
- SET ABSPEN=$ORDER(^AUPNMCR(ABSPEN))
- IF +ABSPEN=0
- QUIT
- Begin DoDot:1
- +5 SET ABSPDPT=$PIECE(^AUPNMCR(ABSPEN,0),U,1)
- +6 ;Still have to look out for that...
- IF $GET(^DPT(ABSPDPT,0))=""
- QUIT
- +7 IF $DATA(^DPT(ABSPDPT,.35))
- IF $PIECE(^(.35),U,1)]""
- IF $PIECE(^(.35),U,1)<ABSPELDT
- QUIT
- +8 SET ABSPEIEN=0
- +9 FOR
- SET ABSPEIEN=$ORDER(^AUPNMCR(ABSPEN,11,ABSPEIEN))
- IF +ABSPEIEN=0
- QUIT
- Begin DoDot:2
- +10 ;coverage type
- SET ABSPCOV=$PIECE($GET(^AUPNMCR(ABSPEN,11,ABSPEIEN,0)),U,3)
- +11 IF ABSPCOV'="D"
- QUIT
- +12 ; plan name (pointer to ins file)
- SET ABSPPIEN=$PIECE($GET(^AUPNMCR(ABSPEN,11,ABSPEIEN,0)),U,4)
- +13 IF ($GET(ABSPPIEN)="")
- SET ABSPQUIT=1
- QUIT
- +14 ;no entry for insurer on requested list
- IF ($GET(ABSPLIST(ABSPPIEN))="")
- SET ABSPQUIT=1
- QUIT
- +15 ;check exclude flag and DOD
- IF ABSPDEAD=0
- IF ($PIECE($GET(^DPT(ABSPEN,.35)),U)'="")
- SET ABSPQUIT=1
- QUIT
- +16 ;ELIG START DATE
- SET ABSPSDT=$PIECE($GET(^AUPNMCR(ABSPEN,11,ABSPEIEN,0)),U)
- +17 ;ELIG END DATE
- SET ABSPEDT=$PIECE($GET(^AUPNMCR(ABSPEN,11,ABSPEIEN,0)),U,2)
- +18 IF (ABSPSDT<=ABSPELDT)&((ABSPEDT>ABSPELDT)!(ABSPEDT=""))
- Begin DoDot:3
- +19 SET ABSPHRN=0
- +20 FOR
- SET ABSPHRN=$ORDER(^AUPNPAT(ABSPEN,41,ABSPHRN))
- IF +ABSPHRN=0
- QUIT
- Begin DoDot:4
- +21 ;location?
- SET ABSPHRL=$PIECE($GET(^AUPNPAT(ABSPEN,41,ABSPHRN,0)),U,1)
- +22 IF ABSPHRL=""
- QUIT
- +23 ;now look in ABSPPHRM array to see if this location is one that we are interested in...
- +24 SET ABSPPHRM=""
- +25 FOR
- SET ABSPPHRM=$ORDER(ABSPPHRM(ABSPPHRM))
- IF ABSPPHRM=""
- QUIT
- Begin DoDot:5
- +26 SET ABSPOUT=""
- +27 FOR
- SET ABSPOUT=$ORDER(ABSPPHRM(ABSPPHRM,ABSPOUT))
- IF ABSPOUT=""
- QUIT
- Begin DoDot:6
- +28 ;Q:$P(ABSPPHRM(ABSPPHRM,ABSPOUT),U,2)'=ABSPHRL ;add info about this patient when we find a pharmacy/outpatient match
- +29 ;add info about this patient when we find a pharmacy/outpatient match
- IF ABSPOUT'=ABSPHRL
- QUIT
- +30 ;inactive?
- SET ABSPHRNS=$PIECE($GET(^AUPNPAT(ABSPEN,41,ABSPHRN,0)),U,5)
- +31 ;check exclude inactive flag and status
- IF (ABSPDEAD=0&ABSPHRN)="I"
- SET ABSPQUIT=1
- QUIT
- +32 SET ABSPPNAM=$PIECE(ABSPPHRM(ABSPPHRM,ABSPOUT),U,1)
- +33 IF ABSPPNAM=""
- QUIT
- +34 ;S ABSPPHRM(ABSPPHRM,ABSPHRL)=ABSPPNAM
- +35 ;insurer name
- SET ABSPNAM=$PIECE($GET(^AUTNINS(ABSPPIEN,0)),U)
- +36 ; S ABSPPN=$P($G(^AUPNMCR(ABSPEN,11,ABSPEIEN,0)),U,6) ;ID
- +37 ;ID ; /IHS/OIT/RAM ; 18 DEC 17 ; new method of retrieving MCRE number / MBI.
- SET ABSPPN=$$GETMCR^AGUTL(ABSPEN,ABSPELDT)
- +38 ;HRN
- SET ABSPHRNN=$PIECE($GET(^AUPNPAT(ABSPEN,41,ABSPHRN,0)),U,2)
- +39 ;count the number of times we use this patient hrn
- SET ABSPPAT(ABSPHRNN)=$GET(ABSPPAT(ABSPHRNN))+1
- +40 ;count the number of times we use this patient DPT
- SET ABSPDPT(ABSPDPT)=$GET(ABSPDPT(ABSPDPT))+1
- +41 SET ^TMP($JOB,"ABSPOSR7",ABSPPHRM,ABSPHRL,ABSPPIEN,ABSPDPT)=ABSPHRNN_U_ABSPSDT_U_ABSPEDT_U_ABSPPN
- +42 SET ABSPCNT(ABSPPHRM,ABSPHRL,ABSPNAM,ABSPPIEN)=$GET(ABSPCNT(ABSPPHRM,ABSPHRL,ABSPNAM,ABSPPIEN))+1
- +43 SET ABSPTOT(ABSPPHRM,ABSPHRL,"TOTAL")=$GET(ABSPTOT(ABSPPHRM,ABSPHRL,"TOTAL"))+1
- +44 IF ($GET(ABSPPAT(ABSPHRNN))=1)
- SET ABSPTOT(ABSPPHRM,"TOTAL")=$GET(ABSPTOT(ABSPPHRM,"TOTAL"))+1
- +45 IF ($GET(ABSPDPT(ABSPDPT))=1)
- SET ABSPTOT("TOTAL")=$GET(ABSPTOT("TOTAL"))+1
- End DoDot:6
- End DoDot:5
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +46 QUIT
- +47 ;
- PRIVATE(ABSPLIST,ABSPELDT,ABSPDEAD,ABSPCNT,ABSPTOT,ABSPPHRM) ; EP FROM ABSPOSR7
- +1 NEW ABSPTIEN,ABSPEN,ABSPNS,ABSPSDT,ABSPEDT,ABSPHRN,ABSPHRNS,ABSPNAM,ABSPHRNN,ABSPPN,ABSPHRL,ABSPOUT
- +2 SET ABSPTIEN=0
- +3 FOR
- SET ABSPTIEN=$ORDER(^AUPNPRVT(ABSPTIEN))
- IF +ABSPTIEN=0
- QUIT
- Begin DoDot:1
- +4 SET ABSPEN=0
- +5 FOR
- SET ABSPEN=$ORDER(^AUPNPRVT(ABSPTIEN,11,ABSPEN))
- IF +ABSPEN=0
- QUIT
- Begin DoDot:2
- +6 SET ABSPNS=$PIECE($GET(^AUPNPRVT(ABSPTIEN,11,ABSPEN,0)),U)
- +7 ;not on list
- IF $GET(ABSPLIST(ABSPNS))=""
- QUIT
- +8 SET ABSPSDT=$PIECE($GET(^AUPNPRVT(ABSPTIEN,11,ABSPEN,0)),U,6)
- +9 SET ABSPEDT=$PIECE($GET(^AUPNPRVT(ABSPTIEN,11,ABSPEN,0)),U,7)
- +10 ;inside date range
- IF ((ABSPSDT=ABSPELDT)!(ABSPSDT<ABSPELDT))
- IF ((ABSPEDT>ABSPELDT)!(ABSPEDT=""))
- Begin DoDot:3
- +11 SET ABSPHRN=0
- +12 FOR
- SET ABSPHRN=$ORDER(^AUPNPAT(ABSPTIEN,41,ABSPHRN))
- IF +ABSPHRN=0
- QUIT
- Begin DoDot:4
- +13 ;location?
- SET ABSPHRL=$PIECE($GET(^AUPNPAT(ABSPEN,41,ABSPHRN,0)),U,1)
- +14 IF ABSPHRL=""
- QUIT
- +15 SET ABSPPHRM=""
- +16 ;now look in ABSPPHRM array to see if this location is one that we are interested in...
- +17 FOR
- SET ABSPPHRM=$ORDER(ABSPPHRM(ABSPPHRM))
- IF ABSPPHRM=""
- QUIT
- Begin DoDot:5
- +18 SET ABSPOUT=""
- +19 NEW ABSPPAT
- +20 FOR
- SET ABSPOUT=$ORDER(ABSPPHRM(ABSPPHRM,ABSPOUT))
- IF ABSPOUT=""
- QUIT
- Begin DoDot:6
- +21 ;Q:$P(ABSPPHRM(ABSPPHRM,ABSPOUT),U,2)'=ABSPHRL ;add info about this patient when we find a pharmacy/outpatient match
- +22 ;add info about this patient when we find a pharmacy/outpatient match
- IF ABSPOUT'=ABSPHRL
- QUIT
- +23 ;inactive?
- SET ABSPHRNS=$PIECE($GET(^AUPNPAT(ABSPTIEN,41,ABSPHRN,0)),U,5)
- +24 ;check exclude inactive flag and status
- IF ABSPDEAD=0
- IF ABSPHRNS="I"
- QUIT
- +25 SET ABSPPNAM=$PIECE(ABSPPHRM(ABSPPHRM,ABSPOUT),U,1)
- +26 IF ABSPPNAM=""
- QUIT
- +27 ;S ABSPPHRM(ABSPPHRM,ABSPHRL)=ABSPPNAM
- +28 ;insurer name
- SET ABSPNAM=$PIECE($GET(^AUTNINS(ABSPNS,0)),U)
- +29 IF $PIECE($GET(^AUPNPRVT(ABSPTIEN,11,ABSPEN,0)),U,8)'=""
- SET ABSPPN=$PIECE($GET(^AUPN3PPH($PIECE($GET(^AUPNPRVT(ABSPTIEN,11,ABSPEN,0)),U,8),0)),U,4)
- +30 ;HRN
- SET ABSPHRNN=$PIECE($GET(^AUPNPAT(ABSPTIEN,41,ABSPHRN,0)),U,2)
- +31 IF ABSPHRNN=""
- SET ABSPHRNN="NONE"
- +32 ;count the number of times we use this patient hrn
- SET ABSPPAT(ABSPHRNN)=$GET(ABSPPAT(ABSPHRNN))+1
- +33 ;count the number of times we use this patient IEN
- SET ABSPDPT(ABSPTIEN)=$GET(ABSPDPT(ABSPTIEN))+1
- +34 SET ^TMP($JOB,"ABSPOSR7",ABSPPHRM,ABSPHRL,ABSPNS,ABSPTIEN)=ABSPHRNN_U_ABSPSDT_U_ABSPEDT_U_ABSPPN
- +35 SET ABSPCNT(ABSPPHRM,ABSPHRL,ABSPNAM,ABSPNS)=+$GET(ABSPCNT(ABSPPHRM,ABSPHRL,ABSPNAM,ABSPNS))+1
- +36 SET ABSPTOT(ABSPPHRM,ABSPHRL,"TOTAL")=$GET(ABSPTOT(ABSPPHRM,ABSPHRL,"TOTAL"))+1
- +37 SET ABSPTOT(ABSPPHRM,"TOTAL")=$GET(ABSPTOT(ABSPPHRM,"TOTAL"))+1
- +38 IF ($GET(ABSPPAT(ABSPHRNN))=1)
- SET ABSPTOT(ABSPPHRM,"TOTAL")=$GET(ABSPTOT(ABSPPHRM,"TOTAL"))+1
- +39 IF ($GET(ABSPDPT(ABSPTIEN))=1)
- SET ABSPTOT("TOTAL")=$GET(ABSPTOT("TOTAL"))+1
- End DoDot:6
- End DoDot:5
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +40 QUIT
- +41 ;
- MEDICAID(ABSPLIST,ABSPELDT,ABSPDEAD,ABSPCNT,ABSPTOT,ABSPPHRM) ;EP FROM ABSPOSR7
- +1 NEW ABSPEN,ABSPEIEN,ABSPCOV,ABSPQUIT,ABSPSDT,ABSPEDT,ABSPHRN,ABSPNAM,ABSPHRNS,ABSPINSN,ABSPHRNN,ABSPPN
- +2 NEW ABSPPIEN,ABSPPN,ABSPDPT,ABSPHRL,ABSPPAT,ABSPFND,ABSPINSP,ABSPMFI,ABSPSTP,ABSPOUT
- +3 SET ABSPEN=0
- SET ABSPQUIT=0
- +4 FOR
- SET ABSPEN=$ORDER(^AUPNMCD(ABSPEN))
- IF +ABSPEN=0
- QUIT
- Begin DoDot:1
- +5 SET ABSPDPT=$PIECE(^AUPNMCD(ABSPEN,0),U,1)
- +6 ;Still have to look out for that...
- IF $GET(^DPT(ABSPDPT,0))=""
- QUIT
- +7 IF $DATA(^DPT(ABSPDPT,.35))
- IF $PIECE(^(.35),U,1)]""
- IF $PIECE(^(.35),U,1)<ABSPELDT
- QUIT
- +8 ;Why would this happen?
- IF $GET(^AUPNMCD(ABSPEN,0))=""
- QUIT
- +9 ;POINTER TO INSURER FILE
- SET ABSPINSP=$PIECE(^AUPNMCD(ABSPEN,0),U,2)
- +10 IF $PIECE($GET(^AUTNINS(ABSPINSP,0)),U,1)="MEDICAID"
- Begin DoDot:2
- +11 ;pointer to the state file
- SET ABSPSTP=$PIECE($GET(^AUPNMCD(ABSPEN,0)),U,4)
- +12 SET ABSPMFI=""
- +13 SET ABSPFND=0
- +14 FOR
- SET ABSPMFI=$ORDER(^AUTNINS(ABSPINSP,13,ABSPMFI))
- IF (ABSPMFI="")!ABSPFND
- QUIT
- Begin DoDot:3
- +15 IF $PIECE($GET(^AUTNINS(ABSPINSP,13,ABSPMFI,0)),U,1)=ABSPSTP
- Begin DoDot:4
- +16 SET ABSPPIEN=$PIECE($GET(^AUTNINS(ABSPINSP,13,ABSPMFI,0)),U,2)
- +17 SET ABSPFND=1
- End DoDot:4
- End DoDot:3
- End DoDot:2
- +18 SET ABSPEIEN=0
- +19 FOR
- SET ABSPEIEN=$ORDER(^AUPNMCD(ABSPEN,11,ABSPEIEN))
- IF +ABSPEIEN=0
- QUIT
- Begin DoDot:2
- +20 IF ($GET(ABSPPIEN)="")
- SET ABSPQUIT=1
- QUIT
- +21 ;no entry for insurer on requested list
- IF ($GET(ABSPLIST(ABSPPIEN))="")
- SET ABSPQUIT=1
- QUIT
- +22 ;check exclude flag and DOD
- IF ABSPDEAD=0
- IF ($PIECE($GET(^DPT(ABSPEN,.35)),U)'="")
- SET ABSPQUIT=1
- QUIT
- +23 ;ELIG START DATE
- SET ABSPSDT=$PIECE($GET(^AUPNMCD(ABSPEN,11,ABSPEIEN,0)),U)
- +24 ;ELIG END DATE
- SET ABSPEDT=$PIECE($GET(^AUPNMCD(ABSPEN,11,ABSPEIEN,0)),U,2)
- +25 IF ABSPSDT=""
- QUIT
- +26 IF (ABSPSDT<=ABSPELDT)&((ABSPEDT>ABSPELDT)!(ABSPEDT=""))
- Begin DoDot:3
- +27 SET ABSPHRN=0
- +28 FOR
- SET ABSPHRN=$ORDER(^AUPNPAT(ABSPEN,41,ABSPHRN))
- IF +ABSPHRN=0
- QUIT
- Begin DoDot:4
- +29 ;location?
- SET ABSPHRL=$PIECE($GET(^AUPNPAT(ABSPEN,41,ABSPHRN,0)),U,1)
- +30 IF ABSPHRL=""
- QUIT
- +31 SET ABSPPHRM=""
- +32 ;now look in ABSPPHRM array to see if this location is one that we are interested in...
- +33 FOR
- SET ABSPPHRM=$ORDER(ABSPPHRM(ABSPPHRM))
- IF ABSPPHRM=""
- QUIT
- Begin DoDot:5
- +34 SET ABSPOUT=""
- +35 FOR
- SET ABSPOUT=$ORDER(ABSPPHRM(ABSPPHRM,ABSPOUT))
- IF ABSPOUT=""
- QUIT
- Begin DoDot:6
- +36 ;Q:$P(ABSPPHRM(ABSPPHRM,ABSPOUT),U,2)'=ABSPHRL ;add info about this patient when we find a pharmacy/outpatient match
- +37 ;add info about this patient when we find a pharmacy/outpatient match
- IF ABSPOUT'=ABSPHRL
- QUIT
- +38 ;inactive?
- SET ABSPHRNS=$PIECE($GET(^AUPNPAT(ABSPEN,41,ABSPHRN,0)),U,5)
- +39 ;check exclude inactive flag and status
- IF (ABSPDEAD=0&ABSPHRN)="I"
- SET ABSPQUIT=1
- QUIT
- +40 SET ABSPPNAM=$PIECE(ABSPPHRM(ABSPPHRM,ABSPOUT),U,1)
- +41 IF ABSPPNAM=""
- QUIT
- +42 ;insurer name
- SET ABSPNAM=$PIECE($GET(^AUTNINS(ABSPPIEN,0)),U)
- +43 ;ID
- SET ABSPPN=$PIECE($GET(^AUPNMCD(ABSPEN,0)),U,3)
- +44 ;HRN
- SET ABSPHRNN=$PIECE($GET(^AUPNPAT(ABSPEN,41,ABSPHRN,0)),U,2)
- +45 ;count the number of times we use this patient hrn
- SET ABSPPAT(ABSPHRNN)=$GET(ABSPPAT(ABSPHRNN))+1
- +46 ;count the number of times we use this patient DPT
- SET ABSPDPT(ABSPDPT)=$GET(ABSPDPT(ABSPDPT))+1
- +47 SET ^TMP($JOB,"ABSPOSR7",ABSPPHRM,ABSPHRL,ABSPPIEN,ABSPDPT)=ABSPHRNN_U_ABSPSDT_U_ABSPEDT_U_ABSPPN
- +48 SET ABSPCNT(ABSPPHRM,ABSPHRL,ABSPNAM,ABSPPIEN)=+$GET(ABSPCNT(ABSPPHRM,ABSPHRL,ABSPNAM,ABSPPIEN))+1
- +49 SET ABSPTOT(ABSPPHRM,ABSPHRL,"TOTAL")=+$GET(ABSPTOT(ABSPPHRM,ABSPHRL,"TOTAL"))+1
- +50 IF ($GET(ABSPPAT(ABSPHRNN))=1)
- SET ABSPTOT(ABSPPHRM,"TOTAL")=$GET(ABSPTOT(ABSPPHRM,"TOTAL"))+1
- +51 IF ($GET(ABSPDPT(ABSPDPT))=1)
- SET ABSPTOT("TOTAL")=$GET(ABSPTOT("TOTAL"))+1
- End DoDot:6
- End DoDot:5
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +52 QUIT
- +53 ;
- +54 ;OIT/CAS/RCS 091213 Patch 46 Move subroutines
- BDT() ;ENTER BEGINING DATE
- +1 NEW ABSPBDT,DIR,X1,X
- +2 WRITE !
- +3 KILL DIR
- +4 SET DIR(0)="DEX"
- +5 SET DIR("A")="Enter Beginning Prescription Release Date"
- +6 DO ^DIR
- +7 IF $DATA(DIRUT)
- QUIT -1
- +8 SET ABSPBDT=+Y
- +9 SET X1=ABSPBDT
- DO C^%DTC
- +10 QUIT X
- EDT() ;ENTER END DATE
- +1 NEW ABSPEDT,DIR,X1,X
- +2 WRITE !
- +3 KILL DIR
- +4 SET DIR(0)="DEX"
- +5 SET DIR("A")="Enter Ending Prescription Release Date"
- +6 DO ^DIR
- +7 IF $DATA(DIRUT)
- QUIT -1
- +8 SET ABSPEDT=+Y
- +9 SET X1=ABSPEDT
- DO C^%DTC
- +10 QUIT X
- CLNC() ; PICK WHICH OR ALL CLINIC PHARMACIES
- +1 NEW DIC,X,Y
- +2 SET DIC="^ABSP(9002313.56,"
- +3 SET DIC(0)="AEMQVZ"
- +4 SET DIC("A")="Please Select a Pharmacy or leave blank for ALL: "
- +5 DO ^DIC
- KILL DIC
- +6 IF X[U
- QUIT -1
- +7 IF Y=-1
- SET ABSPPPHM="ALL"
- +8 IF Y>-1
- SET ABSPPPHM=$PIECE(Y,U,1)
- SET ABSPPHMN=$PIECE(Y,U,2)
- +9 QUIT 1
- DEVSEL ; SELECT DEVICE
- +1 NEW ABSPSTOP
- +2 SET ABSPSTOP=0
- +3 DO ^%ZIS
- +4 IF POP
- Begin DoDot:1
- +5 DO ^%ZIS
- +6 QUIT
- End DoDot:1
- +7 IF $DATA(DUOUT)
- Begin DoDot:1
- +8 DO ZEND^ABSPOSRZ
- +9 SET ABSPSTOP=1
- +10 QUIT
- End DoDot:1
- +11 IF ABSPSTOP
- QUIT
- +12 IF POP
- Begin DoDot:1
- +13 WRITE "DEVICE UNAVAILABLE"
- GOTO DEVSEL
- End DoDot:1
- +14 QUIT
