- BPBSUPD1 ;IHS/CIA/PLS - Update Drug File from AWP data ;10-Aug-2005 21:57;SM
- ;;1.0;PHARMACY BARCODE SCAN;;August 10, 2005
- ;=================================================================
- PSSMAN(MANUAL,BPBSDRG) ; EP
- N PSDRUG,PSSFLAG,PSSXX,PSSZ,DIC,DA
- Q:'$G(BPBSDRG)
- S MANUAL=$G(MANUAL,1)
- D ^PSSDEE2
- S PSSFLAG=0,PSSZ=1,PSSXX=1
- S (FLG1,FLG2,FLG3,FLG4,FLG5,FLG6,FLG7,FLAG,FLGKY,FLGOI)=0
- K ^TMP($J,"ADD"),^TMP($J,"SOL")
- S (DA,DISPDRG)=BPBSDRG
- L +^PSDRUG(DISPDRG):0 I '$T W !,$C(7),"Another person is editing this one." Q
- S PSSHUIDG=1,PSSNEW=0
- D USE^PSSDEE,NOPE^PSSDEE,COMMON,DEA^PSSDEE,MF^PSSDEE K PSSHUIDG
- D HUIDG
- L -^PSDRUG(DISPDRG)
- K FLG3,PSSNEW
- D ^PSSDEE2
- Q
- ;
- HUIDG ;
- N X
- S X="PSSHUIDG"
- X ^%ZOSF("TEST") I $T D DRG^PSSHUIDG(DISPDRG,PSSNEW)
- Q
- COMMON S DIE="^PSDRUG("
- I MANUAL D
- .S DR="[PSSCOMMON]"
- E D SETDRARY(1)
- D ^DIE K DR Q:$D(Y)!($D(DTOUT))
- W:'$D(Y) !,"PRICE PER DISPENSE UNIT: "
- S:'$D(^PSDRUG(DA,660)) $P(^PSDRUG(DA,660),"^",6)=""
- W:'$D(Y) $P(^PSDRUG(DA,660),"^",6)
- D DEA^PSSDEE,CK^PSSDEE,ASKND^PSSDEE,OIKILL^PSSDEE1,COMMON1^PSSDEE
- Q
- ;
- SETDRARY(PSS) ; Set the DR array with fields to edit
- N P61
- S P61=$S($$PATCH^XPDUTL("PSS*1.0*61"):"D PKIND^PSSDDUT2;",1:"")
- S PSS=$G(PSS,0)
- I PSS D
- .S DR=".01;31;"_P61_"3;"_P61_"9;12;14.5;15;13;9999999.02;9999999.31;W !,$P(^DD(50,9999999.32,0),U),"" is "" W:$D(^PSDRUG(DA,999999931)) $P(^(999999931),U,2);9999999.33;2;"
- .S DR(1,50,1)="W !!,""NATIONAL FORMULARY INDICATOR: "" W:$P($G(^PSDRUG(DA,""ND"")),U,11)=1 ""YES"" W:$P($G(^PSDRUG(DA,""ND"")),U,11)="""" ""Not Matched To NDF"""
- .S DR(1,50,2)="W:$P($G(^PSDRUG(DA,""ND"")),U,11)=0 ""NO"";51;52;37;65;101;102;6;100;8;9999999.05;9999999.06"
- .S DR(2,50.037)=".01"
- .S DR(2,50.065)=".01"
- .S DR(2,50.1)=".01;1;2;"
- E D
- .S DR=".01;31;3;9;12;14.5;15;13;9999999.02;9999999.31;W !,$P(^DD(50,9999999.32,0),U),"" is "" W:$D(^PSDRUG(DA,999999931)) $P(^(999999931),U,2);9999999.33;"
- .S DR(1,50,1)="101;2;4:6,8:15;W !,$P(^DD(50,16,0),U),"" is "" W:$D(^PSDRUG(DA,660)) $P(^(660),U,6);17;51;100;50;9999999.05;9999999.06;"
- .S DR(2,50.1)=".01:2"
- Q
- BPBSUPD1 ;IHS/CIA/PLS - Update Drug File from AWP data ;10-Aug-2005 21:57;SM
- +1 ;;1.0;PHARMACY BARCODE SCAN;;August 10, 2005
- +2 ;=================================================================
- PSSMAN(MANUAL,BPBSDRG) ; EP
- +1 NEW PSDRUG,PSSFLAG,PSSXX,PSSZ,DIC,DA
- +2 IF '$GET(BPBSDRG)
- QUIT
- +3 SET MANUAL=$GET(MANUAL,1)
- +4 DO ^PSSDEE2
- +5 SET PSSFLAG=0
- SET PSSZ=1
- SET PSSXX=1
- +6 SET (FLG1,FLG2,FLG3,FLG4,FLG5,FLG6,FLG7,FLAG,FLGKY,FLGOI)=0
- +7 KILL ^TMP($JOB,"ADD"),^TMP($JOB,"SOL")
- +8 SET (DA,DISPDRG)=BPBSDRG
- +9 LOCK +^PSDRUG(DISPDRG):0
- IF '$TEST
- WRITE !,$CHAR(7),"Another person is editing this one."
- QUIT
- +10 SET PSSHUIDG=1
- SET PSSNEW=0
- +11 DO USE^PSSDEE
- DO NOPE^PSSDEE
- DO COMMON
- DO DEA^PSSDEE
- DO MF^PSSDEE
- KILL PSSHUIDG
- +12 DO HUIDG
- +13 LOCK -^PSDRUG(DISPDRG)
- +14 KILL FLG3,PSSNEW
- +15 DO ^PSSDEE2
- +16 QUIT
- +17 ;
- HUIDG ;
- +1 NEW X
- +2 SET X="PSSHUIDG"
- +3 XECUTE ^%ZOSF("TEST")
- IF $TEST
- DO DRG^PSSHUIDG(DISPDRG,PSSNEW)
- +4 QUIT
- COMMON SET DIE="^PSDRUG("
- +1 IF MANUAL
- Begin DoDot:1
- +2 SET DR="[PSSCOMMON]"
- End DoDot:1
- +3 IF '$TEST
- DO SETDRARY(1)
- +4 DO ^DIE
- KILL DR
- IF $DATA(Y)!($DATA(DTOUT))
- QUIT
- +5 IF '$DATA(Y)
- WRITE !,"PRICE PER DISPENSE UNIT: "
- +6 IF '$DATA(^PSDRUG(DA,660))
- SET $PIECE(^PSDRUG(DA,660),"^",6)=""
- +7 IF '$DATA(Y)
- WRITE $PIECE(^PSDRUG(DA,660),"^",6)
- +8 DO DEA^PSSDEE
- DO CK^PSSDEE
- DO ASKND^PSSDEE
- DO OIKILL^PSSDEE1
- DO COMMON1^PSSDEE
- +9 QUIT
- +10 ;
- SETDRARY(PSS) ; Set the DR array with fields to edit
- +1 NEW P61
- +2 SET P61=$SELECT($$PATCH^XPDUTL("PSS*1.0*61"):"D PKIND^PSSDDUT2;",1:"")
- +3 SET PSS=$GET(PSS,0)
- +4 IF PSS
- Begin DoDot:1
- +5 SET DR=".01;31;"_P61_"3;"_P61_"9;12;14.5;15;13;9999999.02;9999999.31;W !,$P(^DD(50,9999999.32,0),U),"" is "" W:$D(^PSDRUG(DA,999999931)) $P(^(999999931),U,2);9999999.33;2;"
- +6 SET DR(1,50,1)="W !!,""NATIONAL FORMULARY INDICATOR: "" W:$P($G(^PSDRUG(DA,""ND"")),U,11)=1 ""YES"" W:$P($G(^PSDRUG(DA,""ND"")),U,11)="""" ""Not Matched To NDF"""
- +7 SET DR(1,50,2)="W:$P($G(^PSDRUG(DA,""ND"")),U,11)=0 ""NO"";51;52;37;65;101;102;6;100;8;9999999.05;9999999.06"
- +8 SET DR(2,50.037)=".01"
- +9 SET DR(2,50.065)=".01"
- +10 SET DR(2,50.1)=".01;1;2;"
- End DoDot:1
- +11 IF '$TEST
- Begin DoDot:1
- +12 SET DR=".01;31;3;9;12;14.5;15;13;9999999.02;9999999.31;W !,$P(^DD(50,9999999.32,0),U),"" is "" W:$D(^PSDRUG(DA,999999931)) $P(^(999999931),U,2);9999999.33;"
- +13 SET DR(1,50,1)="101;2;4:6,8:15;W !,$P(^DD(50,16,0),U),"" is "" W:$D(^PSDRUG(DA,660)) $P(^(660),U,6);17;51;100;50;9999999.05;9999999.06;"
- +14 SET DR(2,50.1)=".01:2"
- End DoDot:1
- +15 QUIT
