PSJRXI.m

PSJRXI ;IHS/DSD/JCM/RLW-LOGS PHARMACY INTERVENTIONS ; 15 May 98 / 9:28 AM

 ;;5.0; INPATIENT MEDICATIONS ;**3**;16 DEC 97

 ; This routine is used to create entries in the APSP INTERVENTION file.

 ;---------------------------------------------------------------

START ;   

 N SAVEX,SAVEY S SAVEX=X,SAVEY=Y

 D INIT

 D DIC G:PSJRXI("QFLG") END

 D EDIT

 S:'$D(PSJNEW("PROVIDER")) PSJNEW("PROVIDER")=$P(^APSPQA(32.4,PSJRXI("DA"),0),"^",3)

END D EOJ

 Q

 ;---------------------------------------------------------------

INIT ;

 W !!,"Now creating Pharmacy Intervention",!

 I $G(PSJDRUG("IEN")) W "For  ",$P($G(^PSDRUG(PSJDRUG("IEN"),0)),"^"),!

 K PSJRXI

 S PSJRXI("QFLG")=0

 Q

 ;

DIC ;

 N DIC,DR,DA,X,DD,DO,Y

 S DIC="^APSPQA(32.4,",DLAYGO=9009032.4,DIC(0)="L",X=DT

 S DIC("DR")=".02////"_PSGP_";.04////"_DUZ_";.05////"_PSJDD_";.06///PHARMACY"

 ;S DIC("DR")=DIC("DR")_$S($G(PSJRX("INTERVENE"))=1:";.07////18",$G(PSJRX("INTERVENE"))=2:";.07////19",1:"")_";.14////0"_";.16////"_$S($G(PSJSITE)]"":PSJSITE,1:"")

 S DIC("DR")=DIC("DR")_";.07"_$S($G(PSJRXREQ)=1:"////18",$G(PSJRXREQ)=2:"////19",1:"////6")_";.14////1"_";.16////"_$S($G(PSJSITE)]"":PSJSITE,1:"")

 D FILE^DICN K DIC,DR,DA

 I Y>0 S PSJRXI("DA")=+Y

 E  S PSJRXI("QFLG")=1 G DICX

 D DIE

DICX K X,Y

 Q

DIE ;

 K DIE,DIC,DR,DA

 S DIE="^APSPQA(32.4,",DA=PSJRXI("DA"),DR=$S($G(PSJRXI("EDIT"))]"":".03:1600",1:".03;.08")

 ;L +^APSPQA(32.4,PSJRXI("DA")) D ^DIE K DIE,DIC,DR,X,Y,DA L -^APSPQA(32.4,PSJRXI("DA"))

 L +^APSPQA(32.4,PSJRXI("DA")):1 E  W !,"Sorry, someone else is editing this intervention!" Q

 D ^DIE K DIE,DIC,DR,X,Y,DA L -^APSPQA(32.4,PSJRXI("DA"))

 W $C(7),!!,"See 'Pharmacy Intervention Menu' if you want to delete this",!,"intervention or for more options.",!

 Q

EDIT ;

 K DIR W ! S DIR(0)="Y",DIR("A")="Would you like to edit this intervention ",DIR("B")="N" D ^DIR K DIR I $D(DIRUT)!'Y G EDITX

 S PSJRXI("EDIT")=1 D DIE

 G EDIT

EDITX K X,Y

 Q

 ;

EOJ ;

 K PSJRXI S X=SAVEX,Y=SAVEY

 Q

 ;

EN1(PSJORDER) ; Entry Point if have internal rx #

 I PSJX']"" W !,$C(7),"No prescription data" Q

 S PSJORDER=$S((PSJORDER["N")!(PSJORDER["P"):"^PS(53.1,"_+PSJORDER,PSJORDER["V":"^PS(55,"_DFN_",""IV"","_+PSJORDER,1:"^PS(55,"_DFN_",5,"_+PSJORDER)_","

 N PSJDFN,PSJNEW,PSJDRUG,PSJY

 I $G(^PS(53.1,PSJX,0))']"" W !,$C(7),"No prescription data" G EN1X

 S PSJRXI("IRXN")=PSJORDER

 K PSJY S PSJY=@(PSJORDER_",0)")

 S PSJDFN=$P(PSJY,"^",15),PSJNEW("PROVIDER")=$P(PSJY,"^",2)

 S PSJDRUG=0,PSJDRUG=$O(^PS(53.1,PSJRXI("IRXN"),1,PSJDRUG)) Q:'PSJDRUG  S PSJDRUG("IEN")=$G(@(PSJORDER_","_PSJDRUG),"^")

 D START

EN1X Q

PSJRXI    ;IHS/DSD/JCM/RLW-LOGS PHARMACY INTERVENTIONS ; 15 May 98 / 9:28 AM

 +1       ;;5.0; INPATIENT MEDICATIONS ;**3**;16 DEC 97

 +2       ; This routine is used to create entries in the APSP INTERVENTION file.

 +3       ;---------------------------------------------------------------

START     ;   

 +1        NEW SAVEX,SAVEY

           SET SAVEX=X

           SET SAVEY=Y

 +2        DO INIT

 +3        DO DIC

           IF PSJRXI("QFLG")

               GOTO END

 +4        DO EDIT

 +5        IF '$DATA(PSJNEW("PROVIDER"))

               SET PSJNEW("PROVIDER")=$PIECE(^APSPQA(32.4,PSJRXI("DA"),0),"^",3)

END        DO EOJ

 +1        QUIT 

 +2       ;---------------------------------------------------------------

INIT      ;

 +1        WRITE !!,"Now creating Pharmacy Intervention",!

 +2        IF $GET(PSJDRUG("IEN"))

               WRITE "For  ",$PIECE($GET(^PSDRUG(PSJDRUG("IEN"),0)),"^"),!

 +3        KILL PSJRXI

 +4        SET PSJRXI("QFLG")=0

 +5        QUIT 

 +6       ;

DIC       ;

 +1        NEW DIC,DR,DA,X,DD,DO,Y

 +2        SET DIC="^APSPQA(32.4,"

           SET DLAYGO=9009032.4

           SET DIC(0)="L"

           SET X=DT

 +3        SET DIC("DR")=".02////"_PSGP_";.04////"_DUZ_";.05////"_PSJDD_";.06///PHARMACY"

 +4       ;S DIC("DR")=DIC("DR")_$S($G(PSJRX("INTERVENE"))=1:";.07////18",$G(PSJRX("INTERVENE"))=2:";.07////19",1:"")_";.14////0"_";.16////"_$S($G(PSJSITE)]"":PSJSITE,1:"")

 +5        SET DIC("DR")=DIC("DR")_";.07"_$SELECT($GET(PSJRXREQ)=1:"////18",$GET(PSJRXREQ)=2:"////19",1:"////6")_";.14////1"_";.16////"_$SELECT($GET(PSJSITE)]"":PSJSITE,1:"")

 +6        DO FILE^DICN

           KILL DIC,DR,DA

 +7        IF Y>0

               SET PSJRXI("DA")=+Y

 +8       IF '$TEST

               SET PSJRXI("QFLG")=1

               GOTO DICX

 +9        DO DIE

DICX       KILL X,Y

 +1        QUIT 

DIE       ;

 +1        KILL DIE,DIC,DR,DA

 +2        SET DIE="^APSPQA(32.4,"

           SET DA=PSJRXI("DA")

           SET DR=$SELECT($GET(PSJRXI("EDIT"))]"":".03:1600",1:".03;.08")

 +3       ;L +^APSPQA(32.4,PSJRXI("DA")) D ^DIE K DIE,DIC,DR,X,Y,DA L -^APSPQA(32.4,PSJRXI("DA"))

 +4        LOCK +^APSPQA(32.4,PSJRXI("DA")):1

          IF '$TEST

               WRITE !,"Sorry, someone else is editing this intervention!"

               QUIT 

 +5        DO ^DIE

           KILL DIE,DIC,DR,X,Y,DA

           LOCK -^APSPQA(32.4,PSJRXI("DA"))

 +6        WRITE $CHAR(7),!!,"See 'Pharmacy Intervention Menu' if you want to delete this",!,"intervention or for more options.",!

 +7        QUIT 

EDIT      ;

 +1        KILL DIR

           WRITE !

           SET DIR(0)="Y"

           SET DIR("A")="Would you like to edit this intervention "

           SET DIR("B")="N"

           DO ^DIR

           KILL DIR

           IF $DATA(DIRUT)!'Y

               GOTO EDITX

 +2        SET PSJRXI("EDIT")=1

           DO DIE

 +3        GOTO EDIT

EDITX      KILL X,Y

 +1        QUIT 

 +2       ;

EOJ       ;

 +1        KILL PSJRXI

           SET X=SAVEX

           SET Y=SAVEY

 +2        QUIT 

 +3       ;

EN1(PSJORDER) ; Entry Point if have internal rx #

 +1        IF PSJX']""

               WRITE !,$CHAR(7),"No prescription data"

               QUIT 

 +2        SET PSJORDER=$SELECT((PSJORDER["N")!(PSJORDER["P"):"^PS(53.1,"_+PSJORDER,PSJORDER["V":"^PS(55,"_DFN_",""IV"","_+PSJORDER,1:"^PS(55,"_DFN_",5,"_+PSJORDER)_","

 +3        NEW PSJDFN,PSJNEW,PSJDRUG,PSJY

 +4        IF $GET(^PS(53.1,PSJX,0))']""

               WRITE !,$CHAR(7),"No prescription data"

               GOTO EN1X

 +5        SET PSJRXI("IRXN")=PSJORDER

 +6        KILL PSJY

           SET PSJY=@(PSJORDER_",0)")

 +7        SET PSJDFN=$PIECE(PSJY,"^",15)

           SET PSJNEW("PROVIDER")=$PIECE(PSJY,"^",2)

 +8        SET PSJDRUG=0

           SET PSJDRUG=$ORDER(^PS(53.1,PSJRXI("IRXN"),1,PSJDRUG))

           IF 'PSJDRUG

               QUIT 

           SET PSJDRUG("IEN")=$GET(@(PSJORDER_","_PSJDRUG),"^")

 +9        DO START

EN1X       QUIT