Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSUMAPR

PSUMAPR.m

Go to the documentation of this file.
  1. PSUMAPR ;BHM/PDW-REPORT OF MAP OAU,NAOU,DA LOCATION TO DIVISION/OUTPATIENT SITES ; 9SEP2003
  1. ;;4.0;PHARMACY BENEFITS MANAGEMENT;**7,9**;MARCH, 2005;Build 6
  1. ;
  1. ;DBIA's
  1. ; Reference to file (#58.1) supported by DBIA 2515
  1. ; Reference to file (#58.8) supported by DBIA 2519
  1. ; Reference to file (#59.7) supported by DBIA 2854
  1. ;
  1. EN ; select Editing or Report of Mapping
  1. N C
  1. K PG,LINE,LINE2
  1. S PSQUIT=0,HDR="",$P(LINE,"=",79)="",$P(LINE2,"-",15)=""
  1. D PGH
  1. AOU S HDR="AR/WS AOU" D PGH1
  1. S C=0
  1. S PSNM="" F S PSNM=$O(^PSI(58.1,"B",PSNM)) Q:PSNM="" D Q:PSQUIT
  1. . S PSDA=0 F S PSDA=$O(^PSI(58.1,"B",PSNM,PSDA)) Q:PSDA'>0 D Q:PSQUIT
  1. .. D BRK Q:PSQUIT
  1. .. S C=C+1
  1. .. W !,PSNM
  1. .. S IEN=PSDA_",1",PSDIV=$$GET1^DIQ(59.79001,IEN,.02),PSOP=$$GET1^DIQ(59.79001,IEN,.03) W:$L(PSDIV) ?30,"Div: ",PSDIV W:$L(PSOP) ?30,"Op: ",PSOP
  1. .. S PSINADT=$$GET1^DIQ(58.1,PSDA,3,"I") I PSINADT W ?60,$$FMTE^XLFDT(PSINADT,"D")
  1. W !
  1. D PG Q:PSQUIT
  1. ;
  1. NAOU ;CS NAOU Drug Accountability 'Primary
  1. Q:PSQUIT
  1. S HDR="CS NAOU" D PGH1
  1. S C=0
  1. S PSNM="" F S PSNM=$O(^PSD(58.8,"B",PSNM)) Q:PSNM="" D Q:PSQUIT
  1. . S PSDA=0 F S PSDA=$O(^PSD(58.8,"B",PSNM,PSDA)) Q:PSDA'>0 D
  1. .. S PSN0=^PSD(58.8,PSDA,0),PSTYP=$P(PSN0,U,2),PSINADT=+$G(^PSD(58.8,PSDA,"I"))
  1. .. I PSTYP="P" Q
  1. .. D BRK Q:PSQUIT
  1. .. S C=C+1
  1. .. W !,PSNM
  1. .. S IEN=PSDA_",1",PSDIV=$$GET1^DIQ(59.79002,IEN,.02),PSOP=$$GET1^DIQ(59.79002,IEN,.03) W:$L(PSDIV) ?30,"Div: ",PSDIV W:$L(PSOP) ?30,"Op: ",PSOP
  1. .. S PSINADT=$$GET1^DIQ(58.8,PSDA,4,"I")
  1. .. I PSINADT W ?60,$$FMTE^XLFDT(PSINADT,"D")
  1. W !
  1. D PG Q:PSQUIT
  1. ;
  1. DRACC ;
  1. Q:PSQUIT
  1. S HDR="DRUG ACCOUNTABILITY"
  1. D PGH1
  1. S C=0
  1. S PSNM="" F S PSNM=$O(^PSD(58.8,"B",PSNM)) Q:PSNM="" D Q:PSQUIT
  1. . S PSDA=0 F S PSDA=$O(^PSD(58.8,"B",PSNM,PSDA)) Q:'PSDA D
  1. .. S PSN0=^PSD(58.8,PSDA,0),PSTYP=$P(PSN0,U,2)
  1. .. S PSINADT=+$G(^PSD(58.8,PSDA,"I"))
  1. .. I PSTYP'="P" Q
  1. .. D BRK Q:PSQUIT
  1. .. S C=C+1
  1. .. W !,PSNM
  1. .. S IEN=PSDA_",1",PSDIV=$$GET1^DIQ(59.79003,IEN,.02),PSOP=$$GET1^DIQ(59.79003,IEN,.03) W:$L(PSDIV) ?30,"Div: ",PSDIV W:$L(PSOP) ?30,"Op: ",PSOP
  1. .. S PSINADT=$$GET1^DIQ(58.8,PSDA,4,"I")
  1. .. I PSINADT W ?60,$$FMTE^XLFDT(PSINADT,"D")
  1. ;
  1. I $E(IOST)="C" W !! K DIR S DIR(0)="EA",DIR("A")="Report Finished <cr>" D ^DIR
  1. Q
  1. EN1 ;Scan for unmapped locations
  1. ;Called from PSUOP0
  1. ;
  1. N PSULOC,PSULOC1,PSULOC2
  1. S PSQUIT=0
  1. D AOU1 ;Look for AR/WS AOU's
  1. D NAOU1 ;Look for CS NAOU's
  1. D DRACC1 ;Look for Drug Accountability Pharmacy Locations
  1. D UNMAPD
  1. D MAPD
  1. Q
  1. ;
  1. AOU1 ;Find AR/WS AOU's and set unmapped locations into AOU array
  1. ;
  1. S PSULOC=" AR/WS AOU's "
  1. ;
  1. K AOU
  1. S PSNM="" F S PSNM=$O(^PSI(58.1,"B",PSNM)) Q:PSNM="" D Q:PSQUIT
  1. .S PSDA=0 F S PSDA=$O(^PSI(58.1,"B",PSNM,PSDA)) Q:PSDA'>0 D
  1. ..S IEN=PSDA_",1",PSDIV=$$GET1^DIQ(59.79001,IEN,.02)
  1. ..S PSOP=$$GET1^DIQ(59.79001,IEN,.03)
  1. ..I '$L(PSDIV),'$L(PSOP) S AOU(PSNM,PSDA)=$$GET1^DIQ(58.1,PSDA,3)
  1. Q
  1. ;
  1. NAOU1 ;Find Controlled Substances AOU's and set unmapped locations
  1. ;into NAOU array
  1. ;
  1. S PSULOC1=" CS NAOUs "
  1. ;
  1. K NAOU
  1. S PSNM="" F S PSNM=$O(^PSD(58.8,"B",PSNM)) Q:PSNM="" D Q:PSQUIT
  1. .S PSDA=0
  1. .F S PSDA=$O(^PSD(58.8,"B",PSNM,PSDA)) Q:PSDA'>0 D
  1. ..S PSN0=^PSD(58.8,PSDA,0)
  1. ..S PSTYP=$P(PSN0,U,2)
  1. ..S PSINADT=+$G(^PSD(58.8,PSDA,"I"))
  1. ..I PSTYP="P" Q
  1. ..S IEN=PSDA_",1"
  1. ..S PSDIV=$$GET1^DIQ(59.79002,IEN,.02)
  1. ..S PSOP=$$GET1^DIQ(59.79002,IEN,.03)
  1. ..I '$L(PSDIV),'$L(PSOP) S NAOU(PSNM,PSDA)=$$GET1^DIQ(58.8,PSDA,4)
  1. Q
  1. ;
  1. DRACC1 ;Find DA Pharmacy Locations and set unmapped locations into DRAC array
  1. ;
  1. S PSULOC2=" DA Pharmacy Locations "
  1. ;
  1. K DRAC
  1. S PSNM="" F S PSNM=$O(^PSD(58.8,"B",PSNM)) Q:PSNM="" D Q:PSQUIT
  1. .S PSDA=0
  1. .F S PSDA=$O(^PSD(58.8,"B",PSNM,PSDA)) Q:'PSDA D
  1. ..S PSN0=^PSD(58.8,PSDA,0),PSTYP=$P(PSN0,U,2)
  1. ..S PSINADT=+$G(^PSD(58.8,PSDA,"I"))
  1. ..I PSTYP'="P" Q
  1. ..S IEN=PSDA_",1"
  1. ..S PSDIV=$$GET1^DIQ(59.79003,IEN,.02)
  1. ..S PSOP=$$GET1^DIQ(59.79003,IEN,.03)
  1. ..I '$L(PSDIV),'$L(PSOP) S DRAC(PSNM,PSDA)=$$GET1^DIQ(58.8,PSDA,4)
  1. Q
  1. ;
  1. MAPD ;Display this if all locations are mapped
  1. ;
  1. I '$D(AOU),'$D(NAOU),'$D(DRAC) D Q
  1. . W !!,?3,"All pharmacy dispensing/procurement locations are mapped.",!
  1. Q
  1. ;
  1. UNMAPD ;Display this if unmapped locations exist
  1. ;
  1. N C
  1. W !
  1. I $D(AOU) S PSNM="" D ;Unmapped AR/WS AOU's
  1. .S C=0
  1. .W !,?5,"The following"_PSULOC_"are not mapped:"
  1. .W !
  1. .F S PSNM=$O(AOU(PSNM)) Q:PSNM="" D Q:PSQUIT
  1. ..S PSDA=0
  1. ..F S PSDA=$O(AOU(PSNM,PSDA)) Q:PSDA'>0 D Q:PSQUIT
  1. ...W !,?10,PSNM
  1. ...I AOU(PSNM,PSDA)'="" W ?40,"**Inactive**"
  1. ...D BRK Q:PSQUIT
  1. ...I C=(IOSL-5) S C=0
  1. ...S C=C+1
  1. W !
  1. D PG Q:PSQUIT
  1. ;
  1. I $D(NAOU) S PSNM="" D ;Unmapped CS NAOUs
  1. .S C=0
  1. .W !,?5,"The following"_PSULOC1_"are not mapped:"
  1. .W !
  1. .F S PSNM=$O(NAOU(PSNM)) Q:PSNM="" D Q:PSQUIT
  1. ..S PSDA=0
  1. ..F S PSDA=$O(NAOU(PSNM,PSDA)) Q:PSDA'>0 D Q:PSQUIT
  1. ...W !,?10,PSNM
  1. ...I NAOU(PSNM,PSDA)'="" W ?40,"**Inactive**"
  1. ...D BRK Q:PSQUIT
  1. ...I C=(IOSL-5) S C=0
  1. ...S C=C+1
  1. W !
  1. D PG Q:PSQUIT
  1. ;
  1. I $D(DRAC) S PSNM="" D ;Unmapped DA Pharmacy Locations
  1. .S C=0
  1. .W !,?5,"The following"_PSULOC2_"are not mapped:"
  1. .W !
  1. .F S PSNM=$O(DRAC(PSNM)) Q:PSNM="" D Q:PSQUIT
  1. ..S PSDA=0
  1. ..F S PSDA=$O(DRAC(PSNM,PSDA)) Q:PSDA'>0 D Q:PSQUIT
  1. ...W !,?10,PSNM
  1. ...I DRAC(PSNM,PSDA)'="" W ?40,"**Inactive**"
  1. ...D BRK Q:PSQUIT
  1. ...I C=(IOSL-5) S C=0
  1. ...S C=C+1
  1. W !
  1. D PG Q:PSQUIT
  1. Q
  1. ;
  1. BRK ;Page break. Occurs in the middle of a list
  1. ;
  1. I C=(IOSL-5) D
  1. .W !
  1. .K DIR I $E(IOST)="C" S DIR(0)="E" D ^DIR
  1. .I $D(Y),Y=0 S PSQUIT=1 Q
  1. .S PG=$G(PG)+1
  1. .W @IOF
  1. ;Q:$E(IOST,1,2)'="C-"!($D(IO("S")))
  1. ;K DIR W !
  1. ;S DIR(0)="E" D ^DIR K DIR
  1. ;I 'Y S PSQUIT=1 Q
  1. Q
  1. ;
  1. PG ;Page break between headers
  1. ;
  1. K DIR I $E(IOST)="C" S DIR(0)="E" D ^DIR I Y=0 S PSQUIT=1 Q
  1. S PG=$G(PG)+1
  1. W @IOF
  1. Q
  1. ;
  1. PGH W @IOF
  1. W !,"MAPPED/UNMAPPED LOCATIONS"
  1. W ?30,$$FMTE^XLFDT(DT)
  1. S PG=$G(PG)+1 W ?60,"PAGE: ",PG,!,LINE,!,"NAME",?30,"DIVISION/OUTPATIENT SITE",?60,"INACTIVE DATE"
  1. PGH1 I $L(HDR) W !!,$G(HDR),!,LINE2
  1. Q
  1. PGB I $Y<(IOSL-4) S PSQUIT=1 Q
  1. PGHB W @IOF
  1. W !,"UNMAPPED LOCATIONS"
  1. W ?30,$$FMTE^XLFDT(DT)
  1. S PG=$G(PG)+1 W ?60,"PAGE: ",PG,!,LINE,!,"NAME",?40,"INACTIVE DATE"
  1. PGH1B I $L(HDR) W !!,$G(HDR),!,LINE2
  1. Q