PSORXI ;IHS/DSD/JCM - logs pharmacy interventions ;03/19/93 11:56
;;7.0;OUTPATIENT PHARMACY;**268,324,251,387,390,417**;DEC 1997;Build 7
;External reference to ^APSPQA(32.4 supported by DBIA 2179
; This routine is used to create entries in the APSP INTERVENTION file.
START ;
D INIT,DIC G:PSORXI("QFLG") END
D EDIT
S:'$D(PSONEW("PROVIDER")) PSONEW("PROVIDER")=$P(^APSPQA(32.4,PSORXI("DA"),0),"^",3)
END D EOJ
Q
INIT ;
W !!,"Now creating Pharmacy Intervention",!
I $G(PSODRUG("IEN")) W "for "_$P($G(^PSDRUG(PSODRUG("IEN"),0)),"^"),!
K PSORXI S PSORXI("QFLG")=0
Q
DIC ;
K DIC,DR,DA,X,Y,DD,DO S DIC="^APSPQA(32.4,",DLAYGO=9009032.4,DIC(0)="L",X=DT
S DIC("DR")=".02////"_+PSODFN_";.04////"_DUZ_";.05////"_PSODRUG("IEN")_";.06///PHARMACY"
S DIC("DR")=DIC("DR")_";.07"_$S($G(PSOIVDSN):"////"_$G(PSOIVDSN),$G(PSORX("INTERVENE"))=1:"////18",$G(PSORX("INTERVENE"))=2:"////19",1:"////6")_";.14////0"_";.16////"_$S($G(PSOSITE)]"":PSOSITE,1:"")
D FILE^DICN K DIC,DR,DA
I Y>0 S PSORXI("DA")=+Y S:$G(PSODAL) PSODAL("DA")=+Y
E S PSORXI("QFLG")=1 G DICX
D DIE
DICX K X,Y
Q
DIE ;
K DIE,DIC,DR,DA
S DIE="^APSPQA(32.4,",DA=PSORXI("DA"),DR=$S($G(PSORXI("EDIT"))]"":".03:1600",1:".03;.08")
L +^APSPQA(32.4,PSORXI("DA")):$S(+$G(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3) D ^DIE K DIE,DIC,DR,X,Y,DA L -^APSPQA(32.4,PSORXI("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 PSORXI("EDIT")=1 D DIE G EDIT
EDITX W ! K X,Y
Q
DUPINV ;Duplicate and file intervention
N PSOARY,PSOARYC,PSOMSG,PSODA,DUP,DIC,DA,DLAYGO,Y,X
S DUP=^TMP($J,"PSOINTERVENE",+PSODFN),DIC="^APSPQA(32.4,",DIC(0)="AEQM"
D GETS^DIQ(9009032.4,DUP,"**","I","PSOARY","PSOMSG")
I $D(PSOMSG) W !,"Error Retrieving Last Duplicate..." G START
L +^APSPQA(32.4):$S(+$G(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3)
K DIC,DR,DA,X,Y,DD,DO
S DIC="^APSPQA(32.4,",DLAYGO=9009032.4,DIC(0)="",X=DT
D FILE^DICN
L -^APSPQA(32.4)
I Y<1 W !,"Error Encountered Filing Duplicate..." Q
S DA=+Y,PSORXI("DA")=+Y,X=0,^TMP($J,"PSOINTERVENE",PSODFN)=+Y
F S X=$O(PSOARY(9009032.4,DUP_",",X)) Q:'X D
.S PSOARYC(9009032.4,DA_",",X)=PSOARY(9009032.4,DUP_",",X,"I")
S PSOARYC(9009032.4,DA_",",.05)=PSODRUG("IEN")
S PSOARYC(9009032.4,DA_",",.15)=""
D FILE^DIE("K","PSOARYC","PSOMSG") I $D(PSOMSG) D G START
.W !,"Error Encountered Filing Duplicate..."
.N DIK S DA=PSORXI("DA"),DIK="^APSPQA(32.4," D ^DIK
W ! D EN^DIQ,EDIT
Q
EOJ ;
K PSORXI
Q
EN1(PSOX) ; Entry Point if have internal rx #
N PSODFN,PSONEW,PSODRUG,PSOY
I $G(^PSRX(+$G(PSOX),0))']"" W !,$C(7),"No prescription data" G EN1X
S PSORXI("IRXN")=PSOX K PSOY S PSOY=^PSRX(PSORXI("IRXN"),0)
S PSODFN=$P(PSOY,"^",2),PSONEW("PROVIDER")=$P(PSOY,"^",4),PSODRUG("IEN")=$P(PSOY,"^",6)
D START
EN1X ;
Q
;
EN2(PSOIVDST,PSOX) ; Entry Point for dose interventions with a prescription
;PSOIVDST = Dosing intervention text
;PSOX = Internal prescription Number
N PSOIVDSN S PSOIVDSN=0
D LOOK I 'PSOIVDSN Q 1
N PSODFN,PSONEW,PSODRUG,PSOY
I $G(^PSRX(+$G(PSOX),0))']"" W !,$C(7),"No prescription data" G EN2X
S PSORXI("IRXN")=PSOX K PSOY S PSOY=^PSRX(PSORXI("IRXN"),0)
S PSODFN=$P(PSOY,"^",2),PSONEW("PROVIDER")=$P(PSOY,"^",4),PSODRUG("IEN")=$P(PSOY,"^",6)
D START K PSOIVDSN
EN2X Q 0
;
EN3(PSOIVDST) ; Entry Point for dose interventions without a prescription
;PSOIVDST = Dosing intervention text
N PSOIVDSN S PSOIVDSN=0
D LOOK I 'PSOIVDSN Q 1
D START K PSOIVDSN
EN3X Q 0
;
LOOK ;Find Internal Number of 32.3 file
S PSOIVDSN=$$FIND1^DIC(9009032.3,"","X",PSOIVDST,"B")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSORXI 3785 printed Dec 13, 2024@02:34:32 Page 2
PSORXI ;IHS/DSD/JCM - logs pharmacy interventions ;03/19/93 11:56
+1 ;;7.0;OUTPATIENT PHARMACY;**268,324,251,387,390,417**;DEC 1997;Build 7
+2 ;External reference to ^APSPQA(32.4 supported by DBIA 2179
+3 ; This routine is used to create entries in the APSP INTERVENTION file.
START ;
+1 DO INIT
DO DIC
if PSORXI("QFLG")
GOTO END
+2 DO EDIT
+3 if '$DATA(PSONEW("PROVIDER"))
SET PSONEW("PROVIDER")=$PIECE(^APSPQA(32.4,PSORXI("DA"),0),"^",3)
END DO EOJ
+1 QUIT
INIT ;
+1 WRITE !!,"Now creating Pharmacy Intervention",!
+2 IF $GET(PSODRUG("IEN"))
WRITE "for "_$PIECE($GET(^PSDRUG(PSODRUG("IEN"),0)),"^"),!
+3 KILL PSORXI
SET PSORXI("QFLG")=0
+4 QUIT
DIC ;
+1 KILL DIC,DR,DA,X,Y,DD,DO
SET DIC="^APSPQA(32.4,"
SET DLAYGO=9009032.4
SET DIC(0)="L"
SET X=DT
+2 SET DIC("DR")=".02////"_+PSODFN_";.04////"_DUZ_";.05////"_PSODRUG("IEN")_";.06///PHARMACY"
+3 SET DIC("DR")=DIC("DR")_";.07"_$SELECT($GET(PSOIVDSN):"////"_$GET(PSOIVDSN),$GET(PSORX("INTERVENE"))=1:"////18",$GET(PSORX("INTERVENE"))=2:"////19",1:"////6")_";.14////0"_";.16////"_$SELECT($GET(PSOSITE)]"":PSOSITE,1:"")
+4 DO FILE^DICN
KILL DIC,DR,DA
+5 IF Y>0
SET PSORXI("DA")=+Y
if $GET(PSODAL)
SET PSODAL("DA")=+Y
+6 IF '$TEST
SET PSORXI("QFLG")=1
GOTO DICX
+7 DO DIE
DICX KILL X,Y
+1 QUIT
DIE ;
+1 KILL DIE,DIC,DR,DA
+2 SET DIE="^APSPQA(32.4,"
SET DA=PSORXI("DA")
SET DR=$SELECT($GET(PSORXI("EDIT"))]"":".03:1600",1:".03;.08")
+3 LOCK +^APSPQA(32.4,PSORXI("DA")):$SELECT(+$GET(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3)
DO ^DIE
KILL DIE,DIC,DR,X,Y,DA
LOCK -^APSPQA(32.4,PSORXI("DA"))
+4 WRITE $CHAR(7),!!,"See 'Pharmacy Intervention Menu' if you want to delete this",!,"intervention or for more options.",!
+5 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 PSORXI("EDIT")=1
DO DIE
GOTO EDIT
EDITX WRITE !
KILL X,Y
+1 QUIT
DUPINV ;Duplicate and file intervention
+1 NEW PSOARY,PSOARYC,PSOMSG,PSODA,DUP,DIC,DA,DLAYGO,Y,X
+2 SET DUP=^TMP($JOB,"PSOINTERVENE",+PSODFN)
SET DIC="^APSPQA(32.4,"
SET DIC(0)="AEQM"
+3 DO GETS^DIQ(9009032.4,DUP,"**","I","PSOARY","PSOMSG")
+4 IF $DATA(PSOMSG)
WRITE !,"Error Retrieving Last Duplicate..."
GOTO START
+5 LOCK +^APSPQA(32.4):$SELECT(+$GET(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3)
+6 KILL DIC,DR,DA,X,Y,DD,DO
+7 SET DIC="^APSPQA(32.4,"
SET DLAYGO=9009032.4
SET DIC(0)=""
SET X=DT
+8 DO FILE^DICN
+9 LOCK -^APSPQA(32.4)
+10 IF Y<1
WRITE !,"Error Encountered Filing Duplicate..."
QUIT
+11 SET DA=+Y
SET PSORXI("DA")=+Y
SET X=0
SET ^TMP($JOB,"PSOINTERVENE",PSODFN)=+Y
+12 FOR
SET X=$ORDER(PSOARY(9009032.4,DUP_",",X))
if 'X
QUIT
Begin DoDot:1
+13 SET PSOARYC(9009032.4,DA_",",X)=PSOARY(9009032.4,DUP_",",X,"I")
End DoDot:1
+14 SET PSOARYC(9009032.4,DA_",",.05)=PSODRUG("IEN")
+15 SET PSOARYC(9009032.4,DA_",",.15)=""
+16 DO FILE^DIE("K","PSOARYC","PSOMSG")
IF $DATA(PSOMSG)
Begin DoDot:1
+17 WRITE !,"Error Encountered Filing Duplicate..."
+18 NEW DIK
SET DA=PSORXI("DA")
SET DIK="^APSPQA(32.4,"
DO ^DIK
End DoDot:1
GOTO START
+19 WRITE !
DO EN^DIQ
DO EDIT
+20 QUIT
EOJ ;
+1 KILL PSORXI
+2 QUIT
EN1(PSOX) ; Entry Point if have internal rx #
+1 NEW PSODFN,PSONEW,PSODRUG,PSOY
+2 IF $GET(^PSRX(+$GET(PSOX),0))']""
WRITE !,$CHAR(7),"No prescription data"
GOTO EN1X
+3 SET PSORXI("IRXN")=PSOX
KILL PSOY
SET PSOY=^PSRX(PSORXI("IRXN"),0)
+4 SET PSODFN=$PIECE(PSOY,"^",2)
SET PSONEW("PROVIDER")=$PIECE(PSOY,"^",4)
SET PSODRUG("IEN")=$PIECE(PSOY,"^",6)
+5 DO START
EN1X ;
+1 QUIT
+2 ;
EN2(PSOIVDST,PSOX) ; Entry Point for dose interventions with a prescription
+1 ;PSOIVDST = Dosing intervention text
+2 ;PSOX = Internal prescription Number
+3 NEW PSOIVDSN
SET PSOIVDSN=0
+4 DO LOOK
IF 'PSOIVDSN
QUIT 1
+5 NEW PSODFN,PSONEW,PSODRUG,PSOY
+6 IF $GET(^PSRX(+$GET(PSOX),0))']""
WRITE !,$CHAR(7),"No prescription data"
GOTO EN2X
+7 SET PSORXI("IRXN")=PSOX
KILL PSOY
SET PSOY=^PSRX(PSORXI("IRXN"),0)
+8 SET PSODFN=$PIECE(PSOY,"^",2)
SET PSONEW("PROVIDER")=$PIECE(PSOY,"^",4)
SET PSODRUG("IEN")=$PIECE(PSOY,"^",6)
+9 DO START
KILL PSOIVDSN
EN2X QUIT 0
+1 ;
EN3(PSOIVDST) ; Entry Point for dose interventions without a prescription
+1 ;PSOIVDST = Dosing intervention text
+2 NEW PSOIVDSN
SET PSOIVDSN=0
+3 DO LOOK
IF 'PSOIVDSN
QUIT 1
+4 DO START
KILL PSOIVDSN
EN3X QUIT 0
+1 ;
LOOK ;Find Internal Number of 32.3 file
+1 SET PSOIVDSN=$$FIND1^DIC(9009032.3,"","X",PSOIVDST,"B")
+2 QUIT
