- 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
