- 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 Feb 19, 2025@00:00:57 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