- PSOHLDA ;BIR/MFR - HOLD/UNHOLD functionality (cont.) ;07/15/96
- ;;7.0;OUTPATIENT PHARMACY;**148,225**;DEC 1997;Build 29
- ;
- HOLD ;hold function
- I $P($G(^PSRX(DA,"STA")),"^")=3 Q
- S RSDT=$S($P(^PSRX(DA,2),"^",13):$P(^PSRX(DA,3),"^"),1:"@"),(PSUS,ACT,RXF,RFN,I)=0 F S I=$O(^PSRX(DA,1,I)) Q:'I D
- .S RXF=I,RFN=RFN+1 S:RFN=1 RSDT=$S('$P(^PSRX(DA,1,I,0),"^",18):$P(^PSRX(DA,2),"^",2),1:$P(^PSRX(DA,1,I,0),"^"))
- .I RFN>1,'$P(^PSRX(DA,1,I,0),"^",18) S RSDT=$P(^PSRX(DA,1,RXF-1,0),"^") Q
- .S:RFN>1 RSDT=$P(^PSRX(DA,1,RXF,0),"^")
- I RXF D
- .S (PSDA,DA(1))=DA,DA=RXF,DIE="^PSRX("_DA(1)_",1,",DR="4" D ^DIE
- .S $P(^PSRX(DA(1),1,DA,0),"^",3)=$S($G(FLD(99.1))]"":$E(FLD(99.1),1,60),1:"")
- .S DA=PSDA K DA(1)
- S DIE="^PSRX(",DR=$S('RXF&('$P(^PSRX(DA,2),"^",13)):"22///@;",1:"")_"99///"_FLD(99)_";99.1///^S X=FLD(99.1);99.2///"_DT_";100///3;101///"_RSDT D ^DIE Q:$D(Y)
- S:$G(PSOHD) VALMSG="RX# "_$P(^PSRX(DA,0),"^")_" has been placed in a hold status."
- K RXRS(DA)
- I +$G(PSDA) S DA=$O(^PS(52.5,"B",PSDA,0)) I DA S:$P($G(^PS(52.5,DA,"P")),"^")=0 PSUS=1 S DIK="^PS(52.5," D ^DIK K DA,DIK
- S:+$G(PSDA) DA=PSDA D ACT
- S PSOHNX=+$P($G(^PSRX(+$G(DA),"H")),"^") D
- .I $G(PSOHNX),$P($G(^PSRX(DA,"H")),"^",2)'="" S COMM=$P($G(^("H")),"^",2) Q
- .S COMM="Medication placed on Hold "_$E(DT,4,5)_"-"_$E(DT,6,7)_"-"_$E(DT,2,3)
- D EN^PSOHLSN1(DA,"OH","",COMM,PSONOOR) K COMM,PSOHNX
- ;
- ; - Closes any OPEN/UNRESOLVED REJECTs and Reverses ECME Claim
- D REVERSE^PSOBPSU1(DA,+$G(RXF),"HLD",2)
- Q
- ;
- ACT ;adds activity info for rx removed or placed on hold
- D NOW^%DTC S NOW=%
- S IR=0 F FDA=0:0 S FDA=$O(^PSRX(DA,"A",FDA)) Q:'FDA S IR=FDA
- S IR=IR+1,^PSRX(DA,"A",0)="^52.3DA^"_IR_"^"_IR
- S ^PSRX(DA,"A",IR,0)=NOW_"^"_$S(ACT:"U",1:"H")_"^"_DUZ_"^"_$S(RXF>5:RXF+1,1:RXF)_"^"_"RX "_$S('ACT:"placed in a",1:"removed from")_" HOLD status "_$S(+$G(PSUS):"and removed from SUSPENSE ",1:"")_"("_$E(DT,4,5)_"-"_$E(DT,6,7)_"-"_$E(DT,2,3)_")"
- K PSUS,RXF,I,FDA,DIC,DIE,DR,Y,X,%,%I,%H,RSDT
- Q
- ;
- RMP ;remove Rx if found in array PSORX("PSOL")
- Q:'$G(DA)
- N I,J,K,PSOX2,PSOX3,PSOX9 S I=0
- F S I=$O(PSORX("PSOL",I)) Q:'I S PSOX2=PSORX("PSOL",I) D:PSOX2[(DA_",")
- .S PSOX9="",K=0 F J=1:1 S PSOX3=$P(PSOX2,",",J) Q:'PSOX3 D
- ..I PSOX3=DA,$P($G(^PSRX(DA,"STA")),"^")=3 S K=1 Q
- ..S PSOX9=PSOX9_$S('PSOX9:"",1:",")_PSOX3
- .I K S:PSOX9]"" PSORX("PSOL",I)=PSOX9_"," K:PSOX9="" PSORX("PSOL",I) D:$D(BBRX(I)) RMB
- Q
- RMB ;remove Rx if found in array BBRX()
- S PSOX2=BBRX(I) D:PSOX2[(DA_",")
- .S PSOX9="" F J=1:1 S PSOX3=$P(PSOX2,",",J) Q:'PSOX3 S:PSOX3'=DA PSOX9=PSOX9_$S('PSOX9:"",1:",")_PSOX3
- .S:PSOX9]"" BBRX(I)=PSOX9_"," K:PSOX9="" BBRX(I)
- Q
- PSOHLDA ;BIR/MFR - HOLD/UNHOLD functionality (cont.) ;07/15/96
- +1 ;;7.0;OUTPATIENT PHARMACY;**148,225**;DEC 1997;Build 29
- +2 ;
- HOLD ;hold function
- +1 IF $PIECE($GET(^PSRX(DA,"STA")),"^")=3
- QUIT
- +2 SET RSDT=$SELECT($PIECE(^PSRX(DA,2),"^",13):$PIECE(^PSRX(DA,3),"^"),1:"@")
- SET (PSUS,ACT,RXF,RFN,I)=0
- FOR
- SET I=$ORDER(^PSRX(DA,1,I))
- IF 'I
- QUIT
- Begin DoDot:1
- +3 SET RXF=I
- SET RFN=RFN+1
- IF RFN=1
- SET RSDT=$SELECT('$PIECE(^PSRX(DA,1,I,0),"^",18):$PIECE(^PSRX(DA,2),"^",2),1:$PIECE(^PSRX(DA,1,I,0),"^"))
- +4 IF RFN>1
- IF '$PIECE(^PSRX(DA,1,I,0),"^",18)
- SET RSDT=$PIECE(^PSRX(DA,1,RXF-1,0),"^")
- QUIT
- +5 IF RFN>1
- SET RSDT=$PIECE(^PSRX(DA,1,RXF,0),"^")
- End DoDot:1
- +6 IF RXF
- Begin DoDot:1
- +7 SET (PSDA,DA(1))=DA
- SET DA=RXF
- SET DIE="^PSRX("_DA(1)_",1,"
- SET DR="4"
- DO ^DIE
- +8 SET $PIECE(^PSRX(DA(1),1,DA,0),"^",3)=$SELECT($GET(FLD(99.1))]"":$EXTRACT(FLD(99.1),1,60),1:"")
- +9 SET DA=PSDA
- KILL DA(1)
- End DoDot:1
- +10 SET DIE="^PSRX("
- SET DR=$SELECT('RXF&('$PIECE(^PSRX(DA,2),"^",13)):"22///@;",1:"")_"99///"_FLD(99)_";99.1///^S X=FLD(99.1);99.2///"_DT_";100///3;101///"_RSDT
- DO ^DIE
- IF $DATA(Y)
- QUIT
- +11 IF $GET(PSOHD)
- SET VALMSG="RX# "_$PIECE(^PSRX(DA,0),"^")_" has been placed in a hold status."
- +12 KILL RXRS(DA)
- +13 IF +$GET(PSDA)
- SET DA=$ORDER(^PS(52.5,"B",PSDA,0))
- IF DA
- IF $PIECE($GET(^PS(52.5,DA,"P")),"^")=0
- SET PSUS=1
- SET DIK="^PS(52.5,"
- DO ^DIK
- KILL DA,DIK
- +14 IF +$GET(PSDA)
- SET DA=PSDA
- DO ACT
- +15 SET PSOHNX=+$PIECE($GET(^PSRX(+$GET(DA),"H")),"^")
- Begin DoDot:1
- +16 IF $GET(PSOHNX)
- IF $PIECE($GET(^PSRX(DA,"H")),"^",2)'=""
- SET COMM=$PIECE($GET(^("H")),"^",2)
- QUIT
- +17 SET COMM="Medication placed on Hold "_$EXTRACT(DT,4,5)_"-"_$EXTRACT(DT,6,7)_"-"_$EXTRACT(DT,2,3)
- End DoDot:1
- +18 DO EN^PSOHLSN1(DA,"OH","",COMM,PSONOOR)
- KILL COMM,PSOHNX
- +19 ;
- +20 ; - Closes any OPEN/UNRESOLVED REJECTs and Reverses ECME Claim
- +21 DO REVERSE^PSOBPSU1(DA,+$GET(RXF),"HLD",2)
- +22 QUIT
- +23 ;
- ACT ;adds activity info for rx removed or placed on hold
- +1 DO NOW^%DTC
- SET NOW=%
- +2 SET IR=0
- FOR FDA=0:0
- SET FDA=$ORDER(^PSRX(DA,"A",FDA))
- IF 'FDA
- QUIT
- SET IR=FDA
- +3 SET IR=IR+1
- SET ^PSRX(DA,"A",0)="^52.3DA^"_IR_"^"_IR
- +4 SET ^PSRX(DA,"A",IR,0)=NOW_"^"_$SELECT(ACT:"U",1:"H")_"^"_DUZ_"^"_...
- ... $SELECT(RXF>5:RXF+1,1:RXF)_"^"_"RX "_$SELECT('ACT:"placed in a",1:"removed from")_" HOLD status "_$SELECT(+$GET(PSUS):"and removed from SUSPENSE ",1:"")_"("_$EXTRACT(DT,4,5)_"-"_$EXTRACT(DT,6,7)_"-"_$EXTRACT(DT,2,3)_")"
- +5 KILL PSUS,RXF,I,FDA,DIC,DIE,DR,Y,X,%,%I,%H,RSDT
- +6 QUIT
- +7 ;
- RMP ;remove Rx if found in array PSORX("PSOL")
- +1 IF '$GET(DA)
- QUIT
- +2 NEW I,J,K,PSOX2,PSOX3,PSOX9
- SET I=0
- +3 FOR
- SET I=$ORDER(PSORX("PSOL",I))
- IF 'I
- QUIT
- SET PSOX2=PSORX("PSOL",I)
- IF PSOX2[(DA_",")
- Begin DoDot:1
- +4 SET PSOX9=""
- SET K=0
- FOR J=1:1
- SET PSOX3=$PIECE(PSOX2,",",J)
- IF 'PSOX3
- QUIT
- Begin DoDot:2
- +5 IF PSOX3=DA
- IF $PIECE($GET(^PSRX(DA,"STA")),"^")=3
- SET K=1
- QUIT
- +6 SET PSOX9=PSOX9_$SELECT('PSOX9:"",1:",")_PSOX3
- End DoDot:2
- +7 IF K
- IF PSOX9]""
- SET PSORX("PSOL",I)=PSOX9_","
- IF PSOX9=""
- KILL PSORX("PSOL",I)
- IF $DATA(BBRX(I))
- DO RMB
- End DoDot:1
- +8 QUIT
- RMB ;remove Rx if found in array BBRX()
- +1 SET PSOX2=BBRX(I)
- IF PSOX2[(DA_",")
- Begin DoDot:1
- +2 SET PSOX9=""
- FOR J=1:1
- SET PSOX3=$PIECE(PSOX2,",",J)
- IF 'PSOX3
- QUIT
- IF PSOX3'=DA
- SET PSOX9=PSOX9_$SELECT('PSOX9:"",1:",")_PSOX3
- +3 IF PSOX9]""
- SET BBRX(I)=PSOX9_","
- IF PSOX9=""
- KILL BBRX(I)
- End DoDot:1
- +4 QUIT
