- PSAGIP1 ;BIR/LTL,JMB-DA receiving from GIP - CONT'D;7/23/97
- ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**8**; 10/24/97
- N PSACOS,PSACO,PSACOD,PSAPC1,PSAPC2,PSAPC3,PSAFND,PSAONDC,PSAQT,PSAC,DA,DIE,DR,XMDUZ,XMSUB,XMY,XMTEXT
- G:'PSACOST!('PSAQTY) NDC
- S PSACOS=+$J((PSACOST/PSAQTY),0,3)
- S PSACO=$G(^PSDRUG(+PSADRUG,660))
- G:PSACOS=+$P(PSACO,U,6)!('$P(PSACO,U,5)) NDC
- S PSAQT=$P($G(^PSD(58.8,+PSALOC,1,+PSADRUG,0)),U,4)
- I PSAQT>0 S PSACOST=PSACOST+(PSAQT*+$P(PSACO,U,6)),PSAQT=PSAQTY+PSAQT,PSACOS=+$J((PSACOST/PSAQT),0,3)
- G:PSACOS=+$P(PSACO,U,6) NDC
- S PSAC=+$J((PSACOS*$P(PSACO,U,5)),0,2)
- S DIE="^PSDRUG(",DA=PSADRUG
- S PSAFND=0,PSAONDC=$P($G(^PSDRUG(PSADRUG,2)),"^",4)
- D:PSANDC'=PSAONDC&(PSANDC'="")
- .S PSAPC1=$L($P(PSANDC,"-")),PSAPC2=$L($P(PSANDC,"-",2)),PSAPC3=$L($P(PSANDC,"-",3))
- .I PSAPC1=4,PSAPC2=4,PSAPC3=2 S PSAFND=1 Q
- .I PSAPC1=5,PSAPC2=3,PSAPC3=2 S PSAFND=1 Q
- .I PSAPC1=5,PSAPC2=4,PSAPC3=1 S PSAFND=1 Q
- .I PSAPC1=5,PSAPC2=4,PSAPC3=2 S PSAFND=1 Q
- .I PSAPC1=6,PSAPC2=4,PSAPC3=2 S PSAFND=1
- S DR=$S(PSAFND:"13////"_PSAC_";31////"_PSANDC,1:"13////"_PSAC) D ^DIE K DIE,DA
- S ^TMP("PSAD",$J,$E($P($G(^PSDRUG(+PSADRUG,0)),U),1,25))=$E($P($G(^PSDRUG(+PSADRUG,0)),U),1,25)_", Item #"_$P($G(^TMP("PSA",$J,PSADRUG)),U,6)_", Old price: $"_$P(PSACO,U,6)_", New price: $"_PSACOS
- I PSANDC'=PSAONDC,PSANDC'="" D
- .S ^TMP("PSAD",$J,$E($P($G(^PSDRUG(+PSADRUG,0)),U),1,25),1)=" Old NDC: "_$S(PSAONDC'="":PSAONDC,1:"None")_", New NDC: "_PSANDC
- .I 'PSAFND S ^TMP("PSAD",$J,$E($P($G(^PSDRUG(+PSADRUG,0)),U),1,25),2)=" The new NDC was not entered in the DRUG file due to an invalid format."
- END Q:$O(^TMP("PSA",$J,PSADRUG))
- N PSAMSG S PSAMSG=$O(^TMP("PSAD",$J,"")) Q:PSAMSG=""
- N PSADRG S PSACNT=1,PSADRG=""
- F S PSADRG=$O(^TMP("PSAD",$J,PSADRG)) Q:PSADRG="" D
- .S ^TMP("PSAMSG",$J,PSACNT)=^TMP("PSAD",$J,PSADRG),PSACNT=PSACNT+1
- .S:$D(^TMP("PSAD",$J,PSADRG,1)) ^TMP("PSAMSG",$J,PSACNT)=^TMP("PSAD",$J,PSADRG,1),PSACNT=PSACNT+1
- .S:$D(^TMP("PSAD",$J,PSADRG,2)) ^TMP("PSAMSG",$J,PSACNT)=^TMP("PSAD",$J,PSADRG,2),PSACNT=PSACNT+1
- S XMDUZ="Price & NDC Updater",XMSUB="DRUG file Price/NDC Update - "_PSAP
- S XMY(DUZ)="",XMTEXT="^TMP(""PSAMSG"",$J,"
- I $P($G(^PSD(58.8,+PSALOC,4,+$G(PSAGIP),0)),U,3)'="" S XX=$P(^(0),"^",3),XXX="G."_XX,XMY(XXX)="" K XX,XXX
- G:'$D(XMY) QUIT D ^XMD
- QUIT K ^TMP("PSAD",$J),^TMP("PSAMSG",$J)
- Q
- NDC ;This is called if the cost has not changed.
- S PSAFND=0,PSAONDC=$P($G(^PSDRUG(PSADRUG,2)),"^",4)
- G:PSANDC=PSAONDC!(PSANDC="") END
- D:PSANDC'=""
- .S PSAPC1=$L($P(PSANDC,"-")),PSAPC2=$L($P(PSANDC,"-",2)),PSAPC3=$L($P(PSANDC,"-",3))
- .I PSAPC1=4,PSAPC2=4,PSAPC3=2 S PSAFND=1
- .I PSAPC1=5,PSAPC2=3,PSAPC3=2 S PSAFND=1
- .I PSAPC1=5,PSAPC2=4,PSAPC3=1 S PSAFND=1
- .I PSAPC1=5,PSAPC2=4,PSAPC3=2 S PSAFND=1
- .I PSAPC1=6,PSAPC2=4,PSAPC3=2 S PSAFND=1
- .I PSAFND S DIE="^PSDRUG(",DA=PSADRUG,DR=";31////^S X=PSANDC" D ^DIE K DIE,DA
- S ^TMP("PSAD",$J,$E($P($G(^PSDRUG(+PSADRUG,0)),U),1,25))=$E($P($G(^PSDRUG(+PSADRUG,0)),U),1,25)_", Item #"_$P($G(^TMP("PSA",$J,PSADRUG)),U,6)
- S ^TMP("PSAD",$J,$E($P($G(^PSDRUG(+PSADRUG,0)),U),1,25),1)=" Old NDC: "_$S(PSAONDC'="":PSAONDC,1:"None")_", New NDC: "_PSANDC
- I 'PSAFND S ^TMP("PSAD",$J,$E($P($G(^PSDRUG(+PSADRUG,0)),U),1,25),2)=" The new NDC was not entered in the DRUG file due to an invalid format."
- G END
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSAGIP1 3335 printed Feb 18, 2025@23:15:43 Page 2
- PSAGIP1 ;BIR/LTL,JMB-DA receiving from GIP - CONT'D;7/23/97
- +1 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**8**; 10/24/97
- +2 NEW PSACOS,PSACO,PSACOD,PSAPC1,PSAPC2,PSAPC3,PSAFND,PSAONDC,PSAQT,PSAC,DA,DIE,DR,XMDUZ,XMSUB,XMY,XMTEXT
- +3 if 'PSACOST!('PSAQTY)
- GOTO NDC
- +4 SET PSACOS=+$JUSTIFY((PSACOST/PSAQTY),0,3)
- +5 SET PSACO=$GET(^PSDRUG(+PSADRUG,660))
- +6 if PSACOS=+$PIECE(PSACO,U,6)!('$PIECE(PSACO,U,5))
- GOTO NDC
- +7 SET PSAQT=$PIECE($GET(^PSD(58.8,+PSALOC,1,+PSADRUG,0)),U,4)
- +8 IF PSAQT>0
- SET PSACOST=PSACOST+(PSAQT*+$PIECE(PSACO,U,6))
- SET PSAQT=PSAQTY+PSAQT
- SET PSACOS=+$JUSTIFY((PSACOST/PSAQT),0,3)
- +9 if PSACOS=+$PIECE(PSACO,U,6)
- GOTO NDC
- +10 SET PSAC=+$JUSTIFY((PSACOS*$PIECE(PSACO,U,5)),0,2)
- +11 SET DIE="^PSDRUG("
- SET DA=PSADRUG
- +12 SET PSAFND=0
- SET PSAONDC=$PIECE($GET(^PSDRUG(PSADRUG,2)),"^",4)
- +13 if PSANDC'=PSAONDC&(PSANDC'="")
- Begin DoDot:1
- +14 SET PSAPC1=$LENGTH($PIECE(PSANDC,"-"))
- SET PSAPC2=$LENGTH($PIECE(PSANDC,"-",2))
- SET PSAPC3=$LENGTH($PIECE(PSANDC,"-",3))
- +15 IF PSAPC1=4
- IF PSAPC2=4
- IF PSAPC3=2
- SET PSAFND=1
- QUIT
- +16 IF PSAPC1=5
- IF PSAPC2=3
- IF PSAPC3=2
- SET PSAFND=1
- QUIT
- +17 IF PSAPC1=5
- IF PSAPC2=4
- IF PSAPC3=1
- SET PSAFND=1
- QUIT
- +18 IF PSAPC1=5
- IF PSAPC2=4
- IF PSAPC3=2
- SET PSAFND=1
- QUIT
- +19 IF PSAPC1=6
- IF PSAPC2=4
- IF PSAPC3=2
- SET PSAFND=1
- End DoDot:1
- +20 SET DR=$SELECT(PSAFND:"13////"_PSAC_";31////"_PSANDC,1:"13////"_PSAC)
- DO ^DIE
- KILL DIE,DA
- +21 SET ^TMP("PSAD",$JOB,$EXTRACT($PIECE($GET(^PSDRUG(+PSADRUG,0)),U),1,25))=$EXTRACT($PIECE($GET(^PSDRUG(+PSADRUG,0)),U),1,25)_", Item #"_$PIECE($GET(^TMP("PSA",$JOB,PSADRUG)),U,6)_", Old price: $"_$PIECE(PSACO,U,6)_", New price: $"_PSACOS
- +22 IF PSANDC'=PSAONDC
- IF PSANDC'=""
- Begin DoDot:1
- +23 SET ^TMP("PSAD",$JOB,$EXTRACT($PIECE($GET(^PSDRUG(+PSADRUG,0)),U),1,25),1)=" Old NDC: "_$SELECT(PSAONDC'="":PSAONDC,1:"None")_", New NDC: "_PSANDC
- +24 IF 'PSAFND
- SET ^TMP("PSAD",$JOB,$EXTRACT($PIECE($GET(^PSDRUG(+PSADRUG,0)),U),1,25),2)=" The new NDC was not entered in the DRUG file due to an invalid format."
- End DoDot:1
- END if $ORDER(^TMP("PSA",$JOB,PSADRUG))
- QUIT
- +1 NEW PSAMSG
- SET PSAMSG=$ORDER(^TMP("PSAD",$JOB,""))
- if PSAMSG=""
- QUIT
- +2 NEW PSADRG
- SET PSACNT=1
- SET PSADRG=""
- +3 FOR
- SET PSADRG=$ORDER(^TMP("PSAD",$JOB,PSADRG))
- if PSADRG=""
- QUIT
- Begin DoDot:1
- +4 SET ^TMP("PSAMSG",$JOB,PSACNT)=^TMP("PSAD",$JOB,PSADRG)
- SET PSACNT=PSACNT+1
- +5 if $DATA(^TMP("PSAD",$JOB,PSADRG,1))
- SET ^TMP("PSAMSG",$JOB,PSACNT)=^TMP("PSAD",$JOB,PSADRG,1)
- SET PSACNT=PSACNT+1
- +6 if $DATA(^TMP("PSAD",$JOB,PSADRG,2))
- SET ^TMP("PSAMSG",$JOB,PSACNT)=^TMP("PSAD",$JOB,PSADRG,2)
- SET PSACNT=PSACNT+1
- End DoDot:1
- +7 SET XMDUZ="Price & NDC Updater"
- SET XMSUB="DRUG file Price/NDC Update - "_PSAP
- +8 SET XMY(DUZ)=""
- SET XMTEXT="^TMP(""PSAMSG"",$J,"
- +9 IF $PIECE($GET(^PSD(58.8,+PSALOC,4,+$GET(PSAGIP),0)),U,3)'=""
- SET XX=$PIECE(^(0),"^",3)
- SET XXX="G."_XX
- SET XMY(XXX)=""
- KILL XX,XXX
- +10 if '$DATA(XMY)
- GOTO QUIT
- DO ^XMD
- QUIT KILL ^TMP("PSAD",$JOB),^TMP("PSAMSG",$JOB)
- +1 QUIT
- NDC ;This is called if the cost has not changed.
- +1 SET PSAFND=0
- SET PSAONDC=$PIECE($GET(^PSDRUG(PSADRUG,2)),"^",4)
- +2 if PSANDC=PSAONDC!(PSANDC="")
- GOTO END
- +3 if PSANDC'=""
- Begin DoDot:1
- +4 SET PSAPC1=$LENGTH($PIECE(PSANDC,"-"))
- SET PSAPC2=$LENGTH($PIECE(PSANDC,"-",2))
- SET PSAPC3=$LENGTH($PIECE(PSANDC,"-",3))
- +5 IF PSAPC1=4
- IF PSAPC2=4
- IF PSAPC3=2
- SET PSAFND=1
- +6 IF PSAPC1=5
- IF PSAPC2=3
- IF PSAPC3=2
- SET PSAFND=1
- +7 IF PSAPC1=5
- IF PSAPC2=4
- IF PSAPC3=1
- SET PSAFND=1
- +8 IF PSAPC1=5
- IF PSAPC2=4
- IF PSAPC3=2
- SET PSAFND=1
- +9 IF PSAPC1=6
- IF PSAPC2=4
- IF PSAPC3=2
- SET PSAFND=1
- +10 IF PSAFND
- SET DIE="^PSDRUG("
- SET DA=PSADRUG
- SET DR=";31////^S X=PSANDC"
- DO ^DIE
- KILL DIE,DA
- End DoDot:1
- +11 SET ^TMP("PSAD",$JOB,$EXTRACT($PIECE($GET(^PSDRUG(+PSADRUG,0)),U),1,25))=$EXTRACT($PIECE($GET(^PSDRUG(+PSADRUG,0)),U),1,25)_", Item #"_$PIECE($GET(^TMP("PSA",$JOB,PSADRUG)),U,6)
- +12 SET ^TMP("PSAD",$JOB,$EXTRACT($PIECE($GET(^PSDRUG(+PSADRUG,0)),U),1,25),1)=" Old NDC: "_$SELECT(PSAONDC'="":PSAONDC,1:"None")_", New NDC: "_PSANDC
- +13 IF 'PSAFND
- SET ^TMP("PSAD",$JOB,$EXTRACT($PIECE($GET(^PSDRUG(+PSADRUG,0)),U),1,25),2)=" The new NDC was not entered in the DRUG file due to an invalid format."
- +14 GOTO END