APSPFNC5 ;IHS/MSC/PLS - Prescription Creation Support ;25-Feb-2014 16:15;DU
;;7.0;IHS PHARMACY MODIFICATIONS;**1011,1016,1018**;Sep 23, 2004;Build 21
;=================================================================
;IHS/MSC/MGH Added seach by type of pharmacy
;Return list of pharmacies
PHMLSTSC(DATA,SFLG,ZIP,RAD,NAME,NFLG,CITY,STATE,PTYPE,ONEOF) ;
N PLST,ZARY,ZC,CNT,IEN
S SFLG=$G(SFLG) ;ZNCT
S:'$L(SFLG) SFLG="A" ;Used when all pharmacy types is checked and no other search criteria
S NFLG=+$G(NFLG) ;0-Starts with name;1-contains name;2-exact match
S DATA=$NA(^TMP("APSPOPHM",$J))
K @DATA
S PLST=$NA(^TMP("APSPPLST",$J))
K @PLST
Q:'$L(SFLG)
S CNT=0
I SFLG["Z" D
.Q:'$G(ZIP)
.D GETZC^APSPFNC2(.ZARY,ZIP,RAD)
.S ZC="",CNT=0 F S ZC=$O(ZARY(ZC)) Q:'$L(ZC) D
..S IEN=0 F S IEN=$O(^APSPOPHM("ZIP",ZC,IEN)) Q:'IEN S @PLST@(IEN)=1_U_ZARY(ZC)
.S @PLST@(0)="ZIPCODE"
I SFLG["N" D
.N LP,RXNM,NM
.Q:'$L(NAME)
.S NM=$$UP^XLFSTR(NAME)
.S LP=0
.I $D(@PLST) D
..F S LP=$O(@PLST@(LP)) Q:'LP D
...Q:'@PLST@(LP)
...S RXNM=$$UP^XLFSTR($P(^APSPOPHM(LP,0),U,10))
...S $P(@PLST@(LP),U)=$S(NFLG=2:RXNM=NM,NFLG:RXNM[NM,1:$E(RXNM,1,$L(NM))=NM)
.E D
..F S LP=$O(^APSPOPHM(LP)) Q:'LP D
...S RXNM=$$UP^XLFSTR($P(^APSPOPHM(LP,0),U))
...S:$S(NFLG=2:RXNM=NM,NFLG:RXNM[NM,1:$E(RXNM,1,$L(NM))=NM) $P(@PLST@(LP),U)=1
..S @PLST@(0)="NAME"
I SFLG["C" D
.N LP,CTY
.;Q:'$L(CITY)
.S CTY=$$UP^XLFSTR(CITY)
.S LP=0
.I $D(@PLST) D
..F S LP=$O(@PLST@(LP)) Q:'LP D
...Q:'@PLST@(LP)
...S $P(@PLST@(LP),U)=($$UP^XLFSTR($P($G(^APSPOPHM(LP,1)),U,4))=STATE)&($S($L(CTY):$E($$UP^XLFSTR($P($G(^APSPOPHM(LP,1)),U,3)),1,$L(CTY))=CTY,1:1))
.E D
..F S LP=$O(^APSPOPHM("D",STATE,LP)) Q:'LP D
...S:($S($L(CTY):$E($$UP^XLFSTR($P($G(^APSPOPHM(LP,1)),U,3)),1,$L(CTY))=CTY,1:1)) $P(@PLST@(LP),U)=1
..S @PLST@(0)="CITY"
;IHS/MSC/MGH Patch 1016 Add selection for type of pharmacy
I SFLG["T" D
.N LP
.S PTYPE=$G(PTYPE)
.S LP=0
.I $D(@PLST) D
..F S LP=$O(@PLST@(LP)) Q:'LP D
...Q:'@PLST@(LP)
...;Loop through type
...S $P(@PLST@(LP),U)=$$SPECID(LP,PTYPE,ONEOF)
.E D
..F S LP=$O(^APSPOPHM(LP)) Q:'LP D
...S:$$SPECID(LP,PTYPE,ONEOF) $P(@PLST@(LP),U)=1
; Forces return of pharmacy list if the only criteria is All Pharmacy Types
I SFLG["A" D
.N LP
.S LP=0
.F S LP=$O(^APSPOPHM(LP)) Q:'LP D
..S $P(@PLST@(LP),U)=1
;IHS/MSC/PLS - 10/01/2013
I (SFLG="Z"!(SFLG="C"))&($$GET^XPAR("ALL","APSP SS PHARMACY MAILORDER")) D
.S PTYPE=1
.S LP=0
.F S LP=$O(^APSPOPHM(LP)) Q:'LP D
..S:$$SPECID(LP,PTYPE,ONEOF) $P(@PLST@(LP),U)="1^99"
;Finish by adding
S LP=0 F S LP=$O(@PLST@(LP)) Q:'LP D
.D:@PLST@(LP) ADDPHM^APSPFNC2(LP,$P(@PLST@(LP),U,2))
Q
SPECID(LP,VAL,ONEOF) ;EP-
N I,J,X,Y,Z,DONE,LIST,VALUE
S I=0,X=0,DONE=0,VALUE=0
S J=$L(VAL,":")
F I=1:1:J S LIST($P(VAL,":",I))="" S VALUE=VALUE+$P(VAL,":",I)
S I=0
F S I=$O(^APSPOPHM(LP,8,I)) Q:'+I!(DONE>0) D
.S Z=$G(^APSPOPHM(LP,8,I,0))
.I ONEOF D
..I $D(LIST(Z)) S DONE=1
.E D
..S X=X+$G(^APSPOPHM(LP,8,I,0))
S VAL=$S(ONEOF:DONE,1:$$AND^XUMF5AU(VALUE,X)=VALUE)
Q VAL
;Q VAL=$S(ONEOF:$$OR^XUMF5AU(VAL,X),1:$$AND^XUMF5AU(VAL,X))
;.;S X=$S(ID=1:"MAIL ORDER",ID=2:"FAX",ID=8:"RETAIL",ID=16:"SPECIALTY",ID=32:"LONG-TERM CARE",ID=64:"24 THOUR",1:"")
;Return list of states
GSTATES(DATA) ;EP
N LP,ST
F LP=1:1 S ST=$P($T(STATES+LP),";;",2) Q:'$L(ST) D
.S DATA(LP)=ST
Q
STATES ;;List of states
;;AL^ALABAMA
;;AK^ALASKA
;;AZ^ARIZONA
;;AR^ARKANSAS
;;CA^CALIFORNIA
;;CO^COLORADO
;;CT^CONNECTICUT
;;DE^DELAWARE
;;FL^FLORIDA
;;GA^GEORGIA
;;GU^GUAM
;;HI^HAWAII
;;ID^IDAHO
;;IL^ILLINOIS
;;IN^INDIANA
;;IA^IOWA
;;KS^KANSAS
;;KY^KENTUCKY
;;LA^LOUISIANA
;;ME^MAINE
;;MP^MARIANAS PACIFIC
;;MD^MARYLAND
;;MA^MASSACHUSETTS
;;MI^MICHIGAN
;;MN^MINNESOTA
;;MS^MISSISSIPPI
;;MO^MISSOURI
;;MT^MONTANA
;;NE^NEBRASKA
;;NV^NEVADA
;;NH^NEW HAMPSHIRE
;;NJ^NEW JERSEY
;;NM^NEW MEXICO
;;NY^NEW YORK
;;NC^NORTH CAROLINA
;;ND^NORTH DAKOTA
;;OH^OHIO
;;OK^OKLAHOMA
;;OR^OREGON
;;PA^PENNSYLVANIA
;;RI^RHODE ISLAND
;;SC^SOUTH CAROLINA
;;SD^SOUTH DAKOTA
;;TN^TENNESSEE
;;TX^TEXAS
;;UT^UTAH
;;VT^VERMONT
;;VA^VIRGINIA
;;WA^WASHINGTON
;;WV^WEST VIRGINIA
;;WI^WISCONSIN
;;WY^WYOMING
APSPFNC5 ;IHS/MSC/PLS - Prescription Creation Support ;25-Feb-2014 16:15;DU
+1 ;;7.0;IHS PHARMACY MODIFICATIONS;**1011,1016,1018**;Sep 23, 2004;Build 21
+2 ;=================================================================
+3 ;IHS/MSC/MGH Added seach by type of pharmacy
+4 ;Return list of pharmacies
PHMLSTSC(DATA,SFLG,ZIP,RAD,NAME,NFLG,CITY,STATE,PTYPE,ONEOF) ;
+1 NEW PLST,ZARY,ZC,CNT,IEN
+2 ;ZNCT
SET SFLG=$GET(SFLG)
+3 ;Used when all pharmacy types is checked and no other search criteria
IF '$LENGTH(SFLG)
SET SFLG="A"
+4 ;0-Starts with name;1-contains name;2-exact match
SET NFLG=+$GET(NFLG)
+5 SET DATA=$NAME(^TMP("APSPOPHM",$JOB))
+6 KILL @DATA
+7 SET PLST=$NAME(^TMP("APSPPLST",$JOB))
+8 KILL @PLST
+9 IF '$LENGTH(SFLG)
QUIT
+10 SET CNT=0
+11 IF SFLG["Z"
Begin DoDot:1
+12 IF '$GET(ZIP)
QUIT
+13 DO GETZC^APSPFNC2(.ZARY,ZIP,RAD)
+14 SET ZC=""
SET CNT=0
FOR
SET ZC=$ORDER(ZARY(ZC))
IF '$LENGTH(ZC)
QUIT
Begin DoDot:2
+15 SET IEN=0
FOR
SET IEN=$ORDER(^APSPOPHM("ZIP",ZC,IEN))
IF 'IEN
QUIT
SET @PLST@(IEN)=1_U_ZARY(ZC)
End DoDot:2
+16 SET @PLST@(0)="ZIPCODE"
End DoDot:1
+17 IF SFLG["N"
Begin DoDot:1
+18 NEW LP,RXNM,NM
+19 IF '$LENGTH(NAME)
QUIT
+20 SET NM=$$UP^XLFSTR(NAME)
+21 SET LP=0
+22 IF $DATA(@PLST)
Begin DoDot:2
+23 FOR
SET LP=$ORDER(@PLST@(LP))
IF 'LP
QUIT
Begin DoDot:3
+24 IF '@PLST@(LP)
QUIT
+25 SET RXNM=$$UP^XLFSTR($PIECE(^APSPOPHM(LP,0),U,10))
+26 SET $PIECE(@PLST@(LP),U)=$SELECT(NFLG=2:RXNM=NM,NFLG:RXNM[NM,1:$EXTRACT(RXNM,1,$LENGTH(NM))=NM)
End DoDot:3
End DoDot:2
+27 IF '$TEST
Begin DoDot:2
+28 FOR
SET LP=$ORDER(^APSPOPHM(LP))
IF 'LP
QUIT
Begin DoDot:3
+29 SET RXNM=$$UP^XLFSTR($PIECE(^APSPOPHM(LP,0),U))
+30 IF $SELECT(NFLG=2
SET $PIECE(@PLST@(LP),U)=1
End DoDot:3
+31 SET @PLST@(0)="NAME"
End DoDot:2
End DoDot:1
+32 IF SFLG["C"
Begin DoDot:1
+33 NEW LP,CTY
+34 ;Q:'$L(CITY)
+35 SET CTY=$$UP^XLFSTR(CITY)
+36 SET LP=0
+37 IF $DATA(@PLST)
Begin DoDot:2
+38 FOR
SET LP=$ORDER(@PLST@(LP))
IF 'LP
QUIT
Begin DoDot:3
+39 IF '@PLST@(LP)
QUIT
+40 SET $PIECE(@PLST@(LP),U)=($$UP^XLFSTR($PIECE($GET(^APSPOPHM(LP,1)),U,4))=STATE)&($SELECT($LENGTH(CTY):$EXTRACT($$UP^XLFSTR($PIECE($GET(^APSPOPHM(LP,1)),U,3)),1,$LENGTH(CTY))=CTY,1:1))
End DoDot:3
End DoDot:2
+41 IF '$TEST
Begin DoDot:2
+42 FOR
SET LP=$ORDER(^APSPOPHM("D",STATE,LP))
IF 'LP
QUIT
Begin DoDot:3
+43 IF ($SELECT($LENGTH(CTY)
SET $PIECE(@PLST@(LP),U)=1
End DoDot:3
+44 SET @PLST@(0)="CITY"
End DoDot:2
End DoDot:1
+45 ;IHS/MSC/MGH Patch 1016 Add selection for type of pharmacy
+46 IF SFLG["T"
Begin DoDot:1
+47 NEW LP
+48 SET PTYPE=$GET(PTYPE)
+49 SET LP=0
+50 IF $DATA(@PLST)
Begin DoDot:2
+51 FOR
SET LP=$ORDER(@PLST@(LP))
IF 'LP
QUIT
Begin DoDot:3
+52 IF '@PLST@(LP)
QUIT
+53 ;Loop through type
+54 SET $PIECE(@PLST@(LP),U)=$$SPECID(LP,PTYPE,ONEOF)
End DoDot:3
End DoDot:2
+55 IF '$TEST
Begin DoDot:2
+56 FOR
SET LP=$ORDER(^APSPOPHM(LP))
IF 'LP
QUIT
Begin DoDot:3
+57 IF $$SPECID(LP,PTYPE,ONEOF)
SET $PIECE(@PLST@(LP),U)=1
End DoDot:3
End DoDot:2
End DoDot:1
+58 ; Forces return of pharmacy list if the only criteria is All Pharmacy Types
+59 IF SFLG["A"
Begin DoDot:1
+60 NEW LP
+61 SET LP=0
+62 FOR
SET LP=$ORDER(^APSPOPHM(LP))
IF 'LP
QUIT
Begin DoDot:2
+63 SET $PIECE(@PLST@(LP),U)=1
End DoDot:2
End DoDot:1
+64 ;IHS/MSC/PLS - 10/01/2013
+65 IF (SFLG="Z"!(SFLG="C"))&($$GET^XPAR("ALL","APSP SS PHARMACY MAILORDER"))
Begin DoDot:1
+66 SET PTYPE=1
+67 SET LP=0
+68 FOR
SET LP=$ORDER(^APSPOPHM(LP))
IF 'LP
QUIT
Begin DoDot:2
+69 IF $$SPECID(LP,PTYPE,ONEOF)
SET $PIECE(@PLST@(LP),U)="1^99"
End DoDot:2
End DoDot:1
+70 ;Finish by adding
+71 SET LP=0
FOR
SET LP=$ORDER(@PLST@(LP))
IF 'LP
QUIT
Begin DoDot:1
+72 IF @PLST@(LP)
DO ADDPHM^APSPFNC2(LP,$PIECE(@PLST@(LP),U,2))
End DoDot:1
+73 QUIT
SPECID(LP,VAL,ONEOF) ;EP-
+1 NEW I,J,X,Y,Z,DONE,LIST,VALUE
+2 SET I=0
SET X=0
SET DONE=0
SET VALUE=0
+3 SET J=$LENGTH(VAL,":")
+4 FOR I=1:1:J
SET LIST($PIECE(VAL,":",I))=""
SET VALUE=VALUE+$PIECE(VAL,":",I)
+5 SET I=0
+6 FOR
SET I=$ORDER(^APSPOPHM(LP,8,I))
IF '+I!(DONE>0)
QUIT
Begin DoDot:1
+7 SET Z=$GET(^APSPOPHM(LP,8,I,0))
+8 IF ONEOF
Begin DoDot:2
+9 IF $DATA(LIST(Z))
SET DONE=1
End DoDot:2
+10 IF '$TEST
Begin DoDot:2
+11 SET X=X+$GET(^APSPOPHM(LP,8,I,0))
End DoDot:2
End DoDot:1
+12 SET VAL=$SELECT(ONEOF:DONE,1:$$AND^XUMF5AU(VALUE,X)=VALUE)
+13 QUIT VAL
+14 ;Q VAL=$S(ONEOF:$$OR^XUMF5AU(VAL,X),1:$$AND^XUMF5AU(VAL,X))
+15 ;.;S X=$S(ID=1:"MAIL ORDER",ID=2:"FAX",ID=8:"RETAIL",ID=16:"SPECIALTY",ID=32:"LONG-TERM CARE",ID=64:"24 THOUR",1:"")
+16 ;Return list of states
GSTATES(DATA) ;EP
+1 NEW LP,ST
+2 FOR LP=1:1
SET ST=$PIECE($TEXT(STATES+LP),";;",2)
IF '$LENGTH(ST)
QUIT
Begin DoDot:1
+3 SET DATA(LP)=ST
End DoDot:1
+4 QUIT
STATES ;;List of states
+1 ;;AL^ALABAMA
+2 ;;AK^ALASKA
+3 ;;AZ^ARIZONA
+4 ;;AR^ARKANSAS
+5 ;;CA^CALIFORNIA
+6 ;;CO^COLORADO
+7 ;;CT^CONNECTICUT
+8 ;;DE^DELAWARE
+9 ;;FL^FLORIDA
+10 ;;GA^GEORGIA
+11 ;;GU^GUAM
+12 ;;HI^HAWAII
+13 ;;ID^IDAHO
+14 ;;IL^ILLINOIS
+15 ;;IN^INDIANA
+16 ;;IA^IOWA
+17 ;;KS^KANSAS
+18 ;;KY^KENTUCKY
+19 ;;LA^LOUISIANA
+20 ;;ME^MAINE
+21 ;;MP^MARIANAS PACIFIC
+22 ;;MD^MARYLAND
+23 ;;MA^MASSACHUSETTS
+24 ;;MI^MICHIGAN
+25 ;;MN^MINNESOTA
+26 ;;MS^MISSISSIPPI
+27 ;;MO^MISSOURI
+28 ;;MT^MONTANA
+29 ;;NE^NEBRASKA
+30 ;;NV^NEVADA
+31 ;;NH^NEW HAMPSHIRE
+32 ;;NJ^NEW JERSEY
+33 ;;NM^NEW MEXICO
+34 ;;NY^NEW YORK
+35 ;;NC^NORTH CAROLINA
+36 ;;ND^NORTH DAKOTA
+37 ;;OH^OHIO
+38 ;;OK^OKLAHOMA
+39 ;;OR^OREGON
+40 ;;PA^PENNSYLVANIA
+41 ;;RI^RHODE ISLAND
+42 ;;SC^SOUTH CAROLINA
+43 ;;SD^SOUTH DAKOTA
+44 ;;TN^TENNESSEE
+45 ;;TX^TEXAS
+46 ;;UT^UTAH
+47 ;;VT^VERMONT
+48 ;;VA^VIRGINIA
+49 ;;WA^WASHINGTON
+50 ;;WV^WEST VIRGINIA
+51 ;;WI^WISCONSIN
+52 ;;WY^WYOMING
