- 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
