- APSPPDEA ;IHS/MSC/MGH - PROVIDER DEA REPORT ;21-Oct-2011 09:16;MGH
- ;;7.0;IHS PHARMACY MODIFICATIONS;**1013**;Sep 23, 2004;Build 33
- EN ;EP
- N APSPTYP,APSPNUM,APSPTERM,APSPQ,APSPDR,APSPDARY,APSPNAME,QFLG,APSPCNT
- S (APSPQ,APSPTYP)=""
- S APSPCNT=0
- ;All or individual providers
- W @IOF
- W !,"Provider IEN Report",!!
- S APSPNUM=$$DIR^APSPUTIL("S^I:Individual Provider;A:All Providers","Lookup Individual Provider or List ALL Providers? ","A",,.APSPQ)
- Q:APSPQ
- I APSPNUM="I" D
- .F D Q:QFLG
- ..S APSPDR=$$GETIEN1^APSPUTIL(200,"Select Provider: ",-1,"B")
- ..I APSPDR<1 S QFLG=1 Q
- ..S APSPNAME=$$GET1^DIQ(200,APSPDR,.01)
- ..S APSPTERM=$$GET1^DIQ(200,APSPDR,9.2,,"I")
- ..I (APSPTERM=""!(APSPTERM>DT))&($P($G(^VA(200,APSPDR,"PS")),U)) D
- ...S X=$$ORDROLE(APSPDR)
- ...I X'=3 W !,APSPNAME_" is not a provider."
- ...I X=3 D
- ....S APSPDARY(APSPNAME)=APSPDR
- ....S APSPCNT=APSPCNT+1
- ..E D
- ...W !,APSPNAME_" is not an active provider."
- ..S QFLG='$$DIRYN^APSPUTIL("Want to Select Another Provider","No","Enter a 'Y' or 'YES' to include more providers in your search",.APSPQ)
- ..S:'QFLG QFLG=APSPQ
- Q:APSPQ
- I APSPNUM="A" D DEV
- I APSPNUM="I"&($D(APSPDARY)) D DEV
- Q
- DEV ;EP
- N XBRP,XBNS
- S XBRP="OUT^APSPPDEA"
- S XBNS="APS*"
- D ^XBDBQUE
- Q
- OUT ;EP
- N IEN,PROV,X,DEA,EXP,PIEN,PRV,TITLE
- U IO
- D HDR
- K ^TMP($J)
- I APSPNUM="A" D
- .S APSPCNT=0
- .S IEN=0 F S IEN=$O(^VA(200,IEN)) Q:IEN=""!('+IEN) D
- ..S X=$$ORDROLE(IEN)
- ..I X=3 D
- ...S APSPTERM=$$GET1^DIQ(200,IEN,9.2,,"I")
- ...I (APSPTERM=""!(APSPTERM>DT))&($P($G(^VA(200,IEN,"PS")),U)) D
- ....S PROV=$$GET1^DIQ(200,IEN,.01)
- ....S APSPDARY(PROV)=IEN
- S PRV=0 F S PRV=$O(APSPDARY(PRV)) Q:PRV=""!(+APSPQ) D
- .S PIEN=$G(APSPDARY(PRV))
- .S DEA=$$GET1^DIQ(200,PIEN,53.2)
- .S EXP=$$GET1^DIQ(200,PIEN,747.44)
- .S TITLE=$E($$GET1^DIQ(200,PIEN,53.5),1,19)
- .W !,$E(PRV,1,25),?26,TITLE,?50,DEA,?65,EXP
- .I $Y+4>IOSL,IOST["C-" D PAUS Q:APSPQ D HDR
- .Q:APSPQ=1
- Q
- PAUS ;
- N DTOUT,DUOUT,DIR
- S DIR("?")="Enter '^' to Halt or Press Return to continue"
- S DIR(0)="FO",DIR("A")="Press Return to continue or '^' to Halt"
- D ^DIR
- I $D(DUOUT) S APSPQ=1
- Q
- HDR ;
- N LIN
- I IOST["C-" W @IOF
- W !,"Provider List Report"
- W !,"Provider Name",?26,"Class",?50,"DEA#",?65,"Exp Date"
- W ! F LIN=1:1:72 W "-"
- W !
- Q
- ORDROLE(IEN) ;EP
- Q:$$HASKEY("OREMAS",IEN)+$$HASKEY("ORELSE",IEN)+$$HASKEY("ORES",IEN)>1 5
- Q:$$HASKEY("OREMAS",IEN) 1
- Q:$$HASKEY("ORELSE",IEN) 2
- Q:$$HASKEY("ORES",IEN)&$$ISPROV(IEN) 3
- Q:$$ISPROV(IEN) 4
- Q 0
- ; Returns true if user is a provider
- ISPROV(IEN) ;EP
- Q $$HASKEY("PROVIDER",IEN)
- ; Returns true if user has key
- ; KEY = Security key (or parameter if begins with "@")
- ; USR = IEN of user to check
- HASKEY(KEY,USR) ;PEP - Does user have key?
- Q:'$L(KEY) 1
- S USR=$G(USR,DUZ)
- I $E(KEY)="@" D GETPAR^CIAVMRPC(.KEY,$E(KEY,2,999),,,,USR) Q ''KEY
- Q ''$D(^XUSEC(KEY,+USR))
- APSPPDEA ;IHS/MSC/MGH - PROVIDER DEA REPORT ;21-Oct-2011 09:16;MGH
- +1 ;;7.0;IHS PHARMACY MODIFICATIONS;**1013**;Sep 23, 2004;Build 33
- EN ;EP
- +1 NEW APSPTYP,APSPNUM,APSPTERM,APSPQ,APSPDR,APSPDARY,APSPNAME,QFLG,APSPCNT
- +2 SET (APSPQ,APSPTYP)=""
- +3 SET APSPCNT=0
- +4 ;All or individual providers
- +5 WRITE @IOF
- +6 WRITE !,"Provider IEN Report",!!
- +7 SET APSPNUM=$$DIR^APSPUTIL("S^I:Individual Provider;A:All Providers","Lookup Individual Provider or List ALL Providers? ","A",,.APSPQ)
- +8 IF APSPQ
- QUIT
- +9 IF APSPNUM="I"
- Begin DoDot:1
- +10 FOR
- Begin DoDot:2
- +11 SET APSPDR=$$GETIEN1^APSPUTIL(200,"Select Provider: ",-1,"B")
- +12 IF APSPDR<1
- SET QFLG=1
- QUIT
- +13 SET APSPNAME=$$GET1^DIQ(200,APSPDR,.01)
- +14 SET APSPTERM=$$GET1^DIQ(200,APSPDR,9.2,,"I")
- +15 IF (APSPTERM=""!(APSPTERM>DT))&($PIECE($GET(^VA(200,APSPDR,"PS")),U))
- Begin DoDot:3
- +16 SET X=$$ORDROLE(APSPDR)
- +17 IF X'=3
- WRITE !,APSPNAME_" is not a provider."
- +18 IF X=3
- Begin DoDot:4
- +19 SET APSPDARY(APSPNAME)=APSPDR
- +20 SET APSPCNT=APSPCNT+1
- End DoDot:4
- End DoDot:3
- +21 IF '$TEST
- Begin DoDot:3
- +22 WRITE !,APSPNAME_" is not an active provider."
- End DoDot:3
- +23 SET QFLG='$$DIRYN^APSPUTIL("Want to Select Another Provider","No","Enter a 'Y' or 'YES' to include more providers in your search",.APSPQ)
- +24 IF 'QFLG
- SET QFLG=APSPQ
- End DoDot:2
- IF QFLG
- QUIT
- End DoDot:1
- +25 IF APSPQ
- QUIT
- +26 IF APSPNUM="A"
- DO DEV
- +27 IF APSPNUM="I"&($DATA(APSPDARY))
- DO DEV
- +28 QUIT
- DEV ;EP
- +1 NEW XBRP,XBNS
- +2 SET XBRP="OUT^APSPPDEA"
- +3 SET XBNS="APS*"
- +4 DO ^XBDBQUE
- +5 QUIT
- OUT ;EP
- +1 NEW IEN,PROV,X,DEA,EXP,PIEN,PRV,TITLE
- +2 USE IO
- +3 DO HDR
- +4 KILL ^TMP($JOB)
- +5 IF APSPNUM="A"
- Begin DoDot:1
- +6 SET APSPCNT=0
- +7 SET IEN=0
- FOR
- SET IEN=$ORDER(^VA(200,IEN))
- IF IEN=""!('+IEN)
- QUIT
- Begin DoDot:2
- +8 SET X=$$ORDROLE(IEN)
- +9 IF X=3
- Begin DoDot:3
- +10 SET APSPTERM=$$GET1^DIQ(200,IEN,9.2,,"I")
- +11 IF (APSPTERM=""!(APSPTERM>DT))&($PIECE($GET(^VA(200,IEN,"PS")),U))
- Begin DoDot:4
- +12 SET PROV=$$GET1^DIQ(200,IEN,.01)
- +13 SET APSPDARY(PROV)=IEN
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +14 SET PRV=0
- FOR
- SET PRV=$ORDER(APSPDARY(PRV))
- IF PRV=""!(+APSPQ)
- QUIT
- Begin DoDot:1
- +15 SET PIEN=$GET(APSPDARY(PRV))
- +16 SET DEA=$$GET1^DIQ(200,PIEN,53.2)
- +17 SET EXP=$$GET1^DIQ(200,PIEN,747.44)
- +18 SET TITLE=$EXTRACT($$GET1^DIQ(200,PIEN,53.5),1,19)
- +19 WRITE !,$EXTRACT(PRV,1,25),?26,TITLE,?50,DEA,?65,EXP
- +20 IF $Y+4>IOSL
- IF IOST["C-"
- DO PAUS
- IF APSPQ
- QUIT
- DO HDR
- +21 IF APSPQ=1
- QUIT
- End DoDot:1
- +22 QUIT
- PAUS ;
- +1 NEW DTOUT,DUOUT,DIR
- +2 SET DIR("?")="Enter '^' to Halt or Press Return to continue"
- +3 SET DIR(0)="FO"
- SET DIR("A")="Press Return to continue or '^' to Halt"
- +4 DO ^DIR
- +5 IF $DATA(DUOUT)
- SET APSPQ=1
- +6 QUIT
- HDR ;
- +1 NEW LIN
- +2 IF IOST["C-"
- WRITE @IOF
- +3 WRITE !,"Provider List Report"
- +4 WRITE !,"Provider Name",?26,"Class",?50,"DEA#",?65,"Exp Date"
- +5 WRITE !
- FOR LIN=1:1:72
- WRITE "-"
- +6 WRITE !
- +7 QUIT
- ORDROLE(IEN) ;EP
- +1 IF $$HASKEY("OREMAS",IEN)+$$HASKEY("ORELSE",IEN)+$$HASKEY("ORES",IEN)>1
- QUIT 5
- +2 IF $$HASKEY("OREMAS",IEN)
- QUIT 1
- +3 IF $$HASKEY("ORELSE",IEN)
- QUIT 2
- +4 IF $$HASKEY("ORES",IEN)&$$ISPROV(IEN)
- QUIT 3
- +5 IF $$ISPROV(IEN)
- QUIT 4
- +6 QUIT 0
- +7 ; Returns true if user is a provider
- ISPROV(IEN) ;EP
- +1 QUIT $$HASKEY("PROVIDER",IEN)
- +2 ; Returns true if user has key
- +3 ; KEY = Security key (or parameter if begins with "@")
- +4 ; USR = IEN of user to check
- HASKEY(KEY,USR) ;PEP - Does user have key?
- +1 IF '$LENGTH(KEY)
- QUIT 1
- +2 SET USR=$GET(USR,DUZ)
- +3 IF $EXTRACT(KEY)="@"
- DO GETPAR^CIAVMRPC(.KEY,$EXTRACT(KEY,2,999),,,,USR)
- QUIT ''KEY
- +4 QUIT ''$DATA(^XUSEC(KEY,+USR))
