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

PSUMAP0.m

Go to the documentation of this file. 
  1. PSUMAP0 ;BHM/PDW-MAP OAU,NAOU,DA LOCATION TO DIVISION/OUTPATIENT SITES ; 4/12/07 2:12pm
  1.  ;;4.0;PHARMACY BENEFITS MANAGEMENT;**12**;MARCH, 2005;Build 19
  1.  ;
  1.  ;DBIA's
  1.  ;Reference to file (#59.7) supported by DBIA 2854
  1.  ;
  1. EN ; select Editing or Report of Mapping
  1.  W @IOF,!,?10,"MAPPING PHARMACY LOCATIONS FOR PBM EXTRACTS",!!
  1.  ;
  1. MODP ; module selection prompt
  1.  W !!,?5,"This option allows the mapping of dispensing/procurement locations"
  1.  W !,?5,"from the AR/WS, Controlled Substances, and Drug Accountability"
  1.  W !,?5,"applications to either a Medical Center Division or an Outpatient Site."
  1.  W !,?5,"Any dispensing/procurement data associated with an AR/WS AOU, CS NAOU"
  1.  W !,?5,"or DA Pharmacy Location that has not been mapped will be attributed to"
  1.  W !,?5,"to the facility at which the database resides.  Any unmapped locations"
  1.  W !,?5,"will be displayed upon entering the option.",!
  1.  ;
  1.  D EN1^PSUMAPR ;scan and report unmapped locations
  1.  W @IOF
  1.  ;
  1. MODULE ;
  1.  W !!,"Select the dispensing/procurement location to map:",!
  1.  S PSUA(1)="1.  AR/WS Area of Use (AOU)"
  1.  S PSUA(2)="2.  Controlled Substances (CS) Narcotic Area of Use (NAOU)"
  1.  S PSUA(3)="3.  Drug Accountability (DA) Pharmacy location"
  1.  S PSUA(4)="4.  Print Report of Mapped/Unmapped Locations"
  1.  F I=1:1:4 W !,?10,PSUA(I)
  1.  W !!,?2,"You may select all by entering 'A' for ALL or by using '1:4'.",!
  1.  W !,?2,"Select the dispensing/procurement location: "
  1.  R X:DTIME E  W !!,"Nothing Selected - Exiting",! H 3 G EXIT
  1.  I X["^" G EXIT:X="^"
  1.  I X="" W "  <??>",$C(7) S X="?"
  1.  ;
  1.  S:"Aa"[$E(X) X="1:4"
  1. MODHLP I X["?" D  G MODULE
  1.  .W !!,"Enter:  A single number to edit (or print) that selection."
  1.  .W !,?8,"A range of code numbers.  Example:  1:3"
  1.  .W !,?8,"Multiple code numbers separated by commas.  Example:  1,3"
  1.  .W !,?8,"The letter A to select ALL items."
  1.  .W !,?8,"A single up-arrow ( ^ ) to exit now without any action."
  1.  S X=$TR(X,"-;_><.A","::::::")
  1.  K PSUMOD
  1.  F PII=1:1:$L(X,",") D
  1.  .S X1=$P(X,",",PII)
  1.  .Q:X1=""
  1.  .I X1[":" D  Q
  1.  ..S XBEG=$P(X1,":",1),XEND=$P(X1,":",2)
  1.  ..I (XBEG="")!(XEND="") Q
  1.  ..F PJJ=XBEG:1:XEND S PSUMOD(PJJ)=""
  1.  ..K PJJ,XBEG,XEND
  1.  .S PSUMOD(X1)=""
  1.  ; modified to fix <UNDEFINED> PSU*3*12 BAJ
  1.  S X="",ERC=0 F  S X=$O(PSUMOD(X)) Q:X=""  I '$D(PSUA(X)) S ERC=1 Q
  1.  I ERC W !!,"<INVALID CHOICE - ",X,", TRY AGAIN>",$C(7) G MODP
  1.  I '$D(PSUMOD) W !!,"No choices were made." K DIR S DIR(0)="E",DIR("A")="EXITING" D ^DIR G EXIT
  1.  ;
  1.  ;
  1.  W !!,"You have selected: "
  1.  S X="",PSUOPTS="" F  S X=$O(PSUMOD(X)) Q:X=""  W !,?10,PSUA(X)
  1.  W ! K DIR S DIR(0)="E" D ^DIR G:'Y EXIT
  1.  I $D(PSUMOD(4)) D REPORT K PSUA(4)
  1.  I $D(PSUMOD(1)) D E9001
  1.  I $D(PSUMOD(2)) D E9002
  1.  I $D(PSUMOD(3)) D E9003
  1.  Q
  1. E9001 ;EDIT 90.01 AR/WS AOU MAPPING
  1.  W @IOF,!!,?20,"EDITING Mapping of AR/WS AOUs",!!
  1.  K DIC,DA,DIE
  1.  K Z,ZZ,IENS
  1.  S DA(1)=1
  1.  S DIC="^PS(59.7,1,90.01,",DA(1)=1,DIC(0)="ACEQML"
  1.  S DIC("W")="X XX1,XX2"
  1.  S XX1="S IENS=+Y_"",""_DA(1) S Z=$$GET1^DIQ(59.79001,IENS,.02),ZZ=$$GET1^DIQ(59.79001,IENS,.03) W:$L(Z) ?35,""Div: "",Z W:$L(ZZ) ?35,""OP:  "",ZZ"
  1.  S XX2="S ZZ=$$GET1^DIQ(58.1,+Y,3,""I"") W:ZZ ?65,""**INACTIVE**"""
  1.  D ^DIC
  1.  Q:Y'>0
  1.  S DA=+Y,DIE=DIC
  1.  S ZZ=^PS(59.7,1,90.01,DA,0),XX=$P(ZZ,U,2),YY=$P(ZZ,U,3)
  1.  I YY S DR=".01;.03;S:X'="""" Y=0;.02" I 1
  1.  E  S DR=".01;.02;S:X'="""" Y=0;.03"
  1.  D ^DIE W !
  1.  G E9001
  1.  ;
  1. CHK1 ;check that AOUs are mapped
  1.  K IENS
  1.  S DA=0,DA(1)=1 F  S DA=$O(^PS(59.7,1,90.01,DA)) Q:DA'>0  D
  1.  . S Z=^PS(59.7,1,90.01,DA,0),X=$P(Z,U,2),Y=$P(Z,U,3)
  1.  . I Y,'X Q
  1.  . I 'Y,X Q
  1.  . S IENS=DA_",1" W !,?3,"AR/WS AOU",?15,$$GET1^DIQ(59.79001,IENS,.01),?25," is not mapped."
  1.  I $G(STOP),$G(IENS) K DIR S DIR(0)="E" D ^DIR I X="^" S PSUSTOP=1 I 1
  1.  Q
  1.  ;
  1. E9002 ;EDIT 90.02 CS NAOU MAPPING
  1.  W @IOF,!!,?20,"EDITING Mapping of CS NAOUs",!!
  1.  K DIC,DA,DIE
  1.  K Z,ZZ,IENS
  1.  S DA(1)=1
  1.  S DIC="^PS(59.7,DA(1),90.02,",DIC(0)="AEQMLCZ"
  1.  S DIC("W")="X XX1,XX2"
  1.  S XX1="S IENS=+Y_"",""_DA(1) S Z=$$GET1^DIQ(59.79002,IENS,.02),ZZ=$$GET1^DIQ(59.79002,IENS,.03) W:$L(Z) ?35,""Div: "",Z W:$L(ZZ) ?35,""OP:  "",ZZ"
  1.  S XX2="S ZZ=$$GET1^DIQ(58.8,+Y,4,""I"") W:ZZ ?65,""**INACTIVE** """
  1.  D ^DIC
  1.  Q:Y'>0
  1.  S DA=+Y,DIE=DIC
  1.  S ZZ=^PS(59.7,1,90.02,DA,0),XX=$P(ZZ,U,2),YY=$P(ZZ,U,3)
  1.  I YY S DR=".01;.03;S:X'="""" Y=0;.02" I 1
  1.  E  S DR=".01;.02;S:X'="""" Y=0;.03"
  1.  D ^DIE W !
  1.  G E9002
  1.  ;
  1. CHK2 ;check that NAOUs are mapped
  1.  K IENS
  1.  S DA=0,DA(1)=1 F  S DA=$O(^PS(59.7,1,90.02,DA)) Q:DA'>0  D
  1.  . S Z=^PS(59.7,1,90.02,DA,0),X=$P(Z,U,2),Y=$P(Z,U,3)
  1.  . I Y,'X Q
  1.  . I 'Y,X Q
  1.  . S IENS=DA_",1" W !,?3,"CS NAOU",?15,$$GET1^DIQ(59.79002,IENS,.01),?25," is not mapped."
  1.  Q
  1. E9003 ;EDIT 90.03 DRUG ACCOUNTABILITY LOCATION MAPPING
  1.  W @IOF,!!,?20,"EDITING Mapping of DA Pharmacy Locations",!!
  1.  K DIC,DA,DIE
  1.  K Z,ZZ,IENS
  1.  S DA(1)=1
  1.  S DIC="^PS(59.7,DA(1),90.03,",DIC(0)="AEQMLZ"
  1.  S DIC("W")="X XX1,XX2"
  1.  S XX1="S IENS=+Y_"",""_DA(1) S Z=$$GET1^DIQ(59.79003,IENS,.02),ZZ=$$GET1^DIQ(59.79003,IENS,.03) W:$L(Z) ?35,"" Div: "",Z W:$L(ZZ) ?35,""OP:  "",ZZ"
  1.  S XX2="S ZZ=$$GET1^DIQ(58.8,+Y,4,""I"") W:ZZ ?65,""**INACTIVE** """
  1.  D ^DIC
  1.  Q:Y'>0
  1.  S DA=+Y,DIE=DIC
  1.  S ZZ=^PS(59.7,1,90.03,DA,0),XX=$P(ZZ,U,2),YY=$P(ZZ,U,3)
  1.  I YY S DR=".01;.03;S:X'="""" Y=0;.02" I 1
  1.  E  S DR=".01;.02;S:X'="""" Y=0;.03"
  1.  D ^DIE W !
  1.  G E9003
  1.  ;
  1. CHK3 ;check that DRUG ACCOUNTABILITY LOCATIONs are mapped
  1.  K IENS
  1.  S DA=0,DA(1)=1 F  S DA=$O(^PS(59.7,1,90.03,DA)) Q:DA'>0  D
  1.  . S Z=^PS(59.7,1,90.03,DA,0),X=$P(Z,U,2),Y=$P(Z,U,3)
  1.  . I Y,'X Q
  1.  . I 'Y,X Q
  1.  . S IENS=DA_",1" W !,?3,"DA Phar Loc",?15,$$GET1^DIQ(59.79003,IENS,.01),?25," is not mapped."
  1.  I $G(STOP),$G(IENS) K DIR S DIR(0)="E" D ^DIR I X="^" S PSUSTOP=1 I 1
  1.  Q
  1. REPORT ;Print Mapping Report
  1.  W @IOF,!,"Print Pharmacy Location PBM Extract Mapping Report",!
  1.  S %ZIS="Q" D ^%ZIS
  1.  Q:POP
  1.  I $D(IO("Q")) D QUEUE Q
  1.  D EN^PSUMAPR
  1.  Q
  1. QUEUE S ZTRTN="EN^PSUMAPR",ZTDESC="PRINT REPORT OF PBM EXTRACT MAPPING"
  1.  S ZTREQ="@" D ^%ZTLOAD
  1.  W !,"TASKED with ",$G(ZTSK) I '$G(ZTSK) W ">> DID NOT Task !!",! H 3
  1.  Q
  1. EXIT ;
  1.  Q