PSOCPTRH.m

PSOCPTRH ;BHAM ISC/SAB,RTR - PUT IN CHAMPUS HOLD ; 4/29/93 10:55

 ;;7.0;OUTPATIENT PHARMACY;;DEC 1997

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_"^"_ACT_"^"_DUZ_"^"_$S(RXF'<0&(RXF<6):RXF,1:(RXF+1))_"^"_"RX "_"Rx placed in a HOLD status for CHAMPUS billing."

 K PSUS,RXF,I,FDA,DIC,DIE,DR,Y,X,%,%I,%H,RSDT

 Q

 ;

H ;hold function

 I $P($G(^PSRX(DA,"STA")),"^")=3 Q

 S RSDT="@",ACT="H",(PSUS,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=$P(^PSRX(DA,2),"^",2) S:RFN>1 RSDT=$P(^(I-1,0),"^")

 I RXF S (PSDA,DA(1))=DA,DA=RXF S $P(^PSRX(DA(1),1,RXF,0),"^",3)="CHAMPUS billing",$P(^(0),"^",5)=$G(DUZ) S DA=PSDA K DA(1)

 S PSHORX=DA S DIE="^PSRX(",DR=$S('RXF:"22///@;",1:"")_"99///"_FLD(99)_";99.1///"_FLD(99.1)_";99.2///"_DT_";100///3;101///"_RSDT D ^DIE

 S DA=PSHORX D EN^PSOHLSN1(DA,"OH","","Rx placed in hold status (CHAMPUS billing)","A") S DA=PSHORX K PSHORX

 W !!,"RX# "_$P(^PSRX(DA,0),"^")_" Has been placed in a Hold status. (CHAMPUS BILLING)",!

 I $G(PSTRIVER) K DIR S DIR(0)="E",DIR("A")="Press RETURN to continue" D ^DIR K DIR

 I +$G(PSDA) S DA=$O(^PS(52.5,"B",PSDA,0)) I DA S DIK="^PS(52.5,",PSUS=1 D ^DIK K DA,DIK

 S:+$G(PSDA) DA=PSDA D ACT

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PSOCPTRH   1374     printed  Apr 09, 2024@21:31:07                                                                                                                                                                                                    Page 2

PSOCPTRH  ;BHAM ISC/SAB,RTR - PUT IN CHAMPUS HOLD ; 4/29/93 10:55

 +1       ;;7.0;OUTPATIENT PHARMACY;;DEC 1997

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_"^"_ACT_"^"_DUZ_"^"_$SELECT(RXF'<0&(RXF<6):RXF,1:(RXF+1))_"^"_"RX "_"Rx placed in a HOLD status for CHAMPUS billing."

 +5        KILL PSUS,RXF,I,FDA,DIC,DIE,DR,Y,X,%,%I,%H,RSDT

 +6        QUIT 

 +7       ;

H         ;hold function

 +1        IF $PIECE($GET(^PSRX(DA,"STA")),"^")=3

               QUIT 

 +2        SET RSDT="@"

           SET ACT="H"

           SET (PSUS,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=$PIECE(^PSRX(DA,2),"^",2)

                   if RFN>1

                       SET RSDT=$PIECE(^(I-1,0),"^")

               End DoDot:1

 +4        IF RXF

               SET (PSDA,DA(1))=DA

               SET DA=RXF

               SET $PIECE(^PSRX(DA(1),1,RXF,0),"^",3)="CHAMPUS billing"

               SET $PIECE(^(0),"^",5)=$GET(DUZ)

               SET DA=PSDA

               KILL DA(1)

 +5        SET PSHORX=DA

           SET DIE="^PSRX("

           SET DR=$SELECT('RXF:"22///@;",1:"")_"99///"_FLD(99)_";99.1///"_FLD(99.1)_";99.2///"_DT_";100///3;101///"_RSDT

           DO ^DIE

 +6        SET DA=PSHORX

           DO EN^PSOHLSN1(DA,"OH","","Rx placed in hold status (CHAMPUS billing)","A")

           SET DA=PSHORX

           KILL PSHORX

 +7        WRITE !!,"RX# "_$PIECE(^PSRX(DA,0),"^")_" Has been placed in a Hold status. (CHAMPUS BILLING)",!

 +8        IF $GET(PSTRIVER)

               KILL DIR

               SET DIR(0)="E"

               SET DIR("A")="Press RETURN to continue"

               DO ^DIR

               KILL DIR

 +9        IF +$GET(PSDA)

               SET DA=$ORDER(^PS(52.5,"B",PSDA,0))

               IF DA

                   SET DIK="^PS(52.5,"

                   SET PSUS=1

                   DO ^DIK

                   KILL DA,DIK

 +10       if +$GET(PSDA)

               SET DA=PSDA

           DO ACT

 +11       QUIT