PSOPMPPF ;BIRM/MFR - Patient Medication Profile - Preferences ;04/28/05
;;7.0;OUTPATIENT PHARMACY;**260,427**;DEC 1997;Build 21
;
EN ; - Menu option entry point
N PSOCHNG,PSOQUIT,DIR,DIRUT,DIROUT
I '$G(PSOSITE) D ^PSOLSET I '$D(PSOPAR) W $C(7),!!,"Pharmacy Division Must be Selected!",! Q
;
D LOAD(PSOSITE),LST(PSOSITE)
I '$G(PSOQUIT),$G(PSOCHNG) D SAVE(PSOSITE)
;
G END
;
LST(PSOSITE,PSOUSER) ; - Listmanager entry point
N DIR,DIRUT,DIROUT
S (PSOCHNG,PSOQUIT)=0,PSOUSER=+$G(PSOUSER) D FULL^VALM1 W !
;
; - Reset user/division preferences
I (PSOUSER&$D(^PS(52.85,PSOSITE,"USER",PSOUSER)))!('PSOUSER&($$GET1^DIQ(52.85,PSOSITE,1)'="")) D
. D DISPLAY(PSOSITE,PSOUSER)
. S DIR("A")=" Delete this default view? "
. S DIR(0)="YA",DIR("B")="NO" D ^DIR I $D(DIRUT)!$D(DIROUT) S PSOQUIT=1 Q
. I Y=1 D DELETE(PSOSITE,PSOUSER),LOAD(PSOSITE,PSOUSER)
. W !
E W !,"Division: ",$$GET1^DIQ(59,PSOSITE,.01),!
I PSOQUIT Q
;
EXPDC ; - Expiration/Discontinued Cutoff Date
K DIR,DIRUT,DIROUT,SAVEX
S DIR(0)="NA^0:9999",DIR("A")="EXP/CANCEL CUTOFF: ",DIR("B")=PSOEXDCE
S DIR("?",1)="Enter the maximum number of days for an expired and/or"
S DIR("?")="discontinued prescription to be cut from the profile."
D ^DIR I $D(DIRUT)!$D(DIROUT) G @$$GOTO(X,"EXPDC")
W " DAYS" S PSOEXDCE=X,X="T"_$S(X:"-"_X,1:"") D ^%DT S PSOEXPDC=Y
D CHANGED(PSOSITE,PSOUSER,"EXPDC",PSOEXDCE)
;
SRTBY ; - Sort By
K DIR,DIRUT,DIROUT
S DIR(0)="SA^RX:Rx#;DR:DRUG NAME;ID:ISSUE DATE;LF:LAST FILL DATE",DIR("B")=PSOSRTBY
S DIR("A")="SORT BY: " D ^DIR I $D(DIRUT)!$D(DIROUT) G @$$GOTO(X,"SRTBY")
S PSOSRTBY=Y D CHANGED(PSOSITE,PSOUSER,"SRTBY",PSOSRTBY)
;
ORDER ; - Sort Order
K DIR,DIRUT,DIROUT
S DIR(0)="SA^A:ASCENDING;D:DESCENDING",DIR("B")=$S(PSORDER="A":"ASCENDING",1:"DESCENDING")
S DIR("A")="SORT ORDER: " D ^DIR I $D(DIRUT)!$D(DIROUT) G @$$GOTO(X,"ORDER")
S PSORDER=Y D CHANGED(PSOSITE,PSOUSER,"ORDER",PSORDER)
;
SIGDP ; - Display SIG
K DIR,DIRUT,DIROUT
S DIR(0)="SA^ON:ON;OFF:OFF",DIR("B")=$S(PSOSIGDP=1:"ON",1:"OFF")
S DIR("A")="DISPLAY SIG: " D ^DIR I $D(DIRUT)!$D(DIROUT) G @$$GOTO(X,"SIGDP")
S Y=$S(X="ON":1,1:0),PSOSIGDP=Y D CHANGED(PSOSITE,PSOUSER,"SIGDP",PSOSIGDP)
;
STSGP ; - Group By Status
K DIR,DIRUT,DIROUT
S DIR(0)="SA^ON:ON;OFF:OFF",DIR("B")=$S(PSOSTSGP=1:"ON",1:"OFF")
S DIR("A")="GROUP BY STATUS: " D ^DIR I $D(DIRUT)!$D(DIROUT) G @$$GOTO(X,"STSGP")
S Y=$S(X="ON":1,1:0),PSOSTSGP=Y D CHANGED(PSOSITE,PSOUSER,"STSGP",PSOSTSGP)
;
ORDCNT ; - Display Order Count
K DIR,DIRUT,DIROUT
S DIR(0)="SA^ON:ON;OFF:OFF",DIR("B")=$S(PSORDCNT=1:"ON",1:"OFF")
S DIR("A")="DISPLAY ORDER COUNT: " D ^DIR I $D(DIRUT)!$D(DIROUT) G @$$GOTO(X,"ORDCNT")
S Y=$S(X="ON":1,1:0),PSORDCNT=Y D CHANGED(PSOSITE,PSOUSER,"ORDCNT",PSORDCNT)
;
EXIT ; Exit
;
; - Save view?
I $G(PSOCHNG),PSOUSER D
. W ! S DIR(0)="YA",DIR("B")="NO",DIR("A")="Save as your default View? "
. D ^DIR I $D(DIRUT)!$D(DIROUT)!(Y=0) Q
. D SAVE(PSOSITE,PSOUSER)
;
S VALMBCK="R"
;
END Q
;
DISPLAY(SITE,USER) ; - Displays the current view
N X,Z,FLG,LN
S (X,Z,FLG)=""
I $G(USER),$D(^PS(52.85,SITE,"USER",+$G(USER))) D
. S X=$$GET1^DIQ(200,USER,.01),Z=^PS(52.85,SITE,"USER",+$G(USER),0),FLG=1
E D
. S X=$$GET1^DIQ(59,SITE,.01),Z=$G(^PS(52.85,SITE,0))
I Z="" Q
S X=X_"'s current default view"_$S(FLG:" ("_$$GET1^DIQ(59,SITE,.01)_")",1:"")_":"
S $P(LN,"-",$L(X))="" W !?5,X,!?5,LN
W !?5,"EXP/CANCEL CUTOFF : ",$P(Z,"^",2)," DAYS"
S X=$P(Z,"^",3) W !?5,"SORT BY : "
W $S(X="RX":"Rx#",X="DR":"DRUG NAME",X="ID":"ISSUE DATE",X="LF":"LAST FILL DATE",1:"??")
W !?5,"SORT ORDER : ",$S($P(Z,"^",4)="A":"ASCENDING",1:"DESCENDING")
W !?5,"DISPLAY SIG : ",$S($P(Z,"^",5):"ON",1:"OFF")
W !?5,"GROUP BY STATUS : ",$S($P(Z,"^",6):"ON",1:"OFF")
W !?5,"DISPLAY ORDER COUNT: ",$S($P(Z,"^",7):"ON",1:"OFF")
W !
Q
;
GOTO(INPUT,HOME) ; - Directed up-arrow
N GOTO,TAG,TRGT
I $P(INPUT,"^",2)="" S PSOQUIT=1 Q "EXIT"
;
S TRGT=$P(INPUT,"^",2)
S TAG("EXP/CANCEL CUTOFF")="EXPDC"
S TAG("SORT BY")="SRTBY"
S TAG("SORT ORDER")="ORDER"
S TAG("DISPLAY SIG")="SIGDP"
S TAG("GROUP BY STATUS")="STSGP"
S TAG("DISPLAY ORDER COUNT")="ORDCNT"
;
S GOTO=HOME
S TAG="" F S TAG=$O(TAG(TAG)) Q:TAG="" I $E(TAG,1,$L(TRGT))=TRGT S GOTO=TAG(TAG) Q
I GOTO=HOME W " ??",$C(7)
;
Q GOTO
;
LOAD(SITE,USER) ; Loading Factory/Division/User preferences
;Input : SITE - Pointer to OUTPATIENT SITE file (#59)
; USER - Pointer to NEW PSERON file (#200)
;Output: PSOEXPDC - Expiration Cutoff Date
; PSOEXDCE - Expiration Cutoff Date (External)
; PSOSRTBY - Sort By
; PSORDER - Sort Order ("A":Asc,"D":Desc)
; PSOSIGDP - Display SIG (1:ON/0:OFF)
; PSORDCNT - Display Order Count (1:ON/0:OFF)
; PSOSTSGP - Group by Status (1:ON/0:OFF)
; PSOSTSEQ - Status Display Order Array
; PSORDSEQ - Group Display Order Array
;
K PSOEXPDC,PSOEXDCE,PSOSRTBY,PSORDER,PSOSTSGP,PSOSIGDP,PSOSTSEQ,PSORDSEQ
;
N X,Y,Z,TMP,STSGRP,STS,ORDGRP,GRPNAM
;
; - Factory Defaults
S PSOEXDCE=120,X="T-120" D ^%DT S PSOEXPDC=Y
S PSOSRTBY="DR",PSORDER="A",PSORDCNT=1,(PSOSTSGP,PSOSIGDP)=0
;
S PSOSTSEQ("A")="1^ACTIVE^A" ; Active
S PSOSTSEQ("S")="1^ACTIVE^S" ; Suspended
S PSOSTSEQ("E")="1^ACTIVE^E" ; Expired
S PSOSTSEQ("DC")="2^DISCONTINUED^DC" ; Discontinued
S PSOSTSEQ("DP")="2^DISCONTINUED^DP" ; Discontinued by Provider
S PSOSTSEQ("DE")="2^DISCONTINUED^DE" ; Discontinued on Edit
S PSOSTSEQ("H")="3^HOLD^H" ; Hold
S PSOSTSEQ("PH")="3^HOLD^PH" ; Provider Hold
S PSOSTSEQ("N")="4^NON-VERIFIED^N" ; Non-Verified
;
S PSORDSEQ("T")="1^REFILL TOO SOON/DUR REJECTS (Third Party)"
S PSORDSEQ("H")="2^OTHER REJECTS PENDING RESOLUTION" ; added for *427
S PSORDSEQ("R")="3^CURRENT ORDERS"
S PSORDSEQ("P")="4^PENDING"
S PSORDSEQ("N")="5^NON-VA MEDS (Not dispensed by VA)"
;
; - User's preferences
I $G(USER),$D(^PS(52.85,SITE,"USER",USER,0)) D SET(^PS(52.85,SITE,"USER",USER,0)) Q
;
; - Division's preferences
I $D(^PS(52.85,SITE,0)) D SET(^PS(52.85,SITE,0)) Q
;
Q
;
CHANGED(SITE,USER,FIELD,VALUE) ; - Sets PSOCHNG so the list can be refreshed
I $G(PSOCHNG) Q
;
; - Saved User's preferences
S Z=""
I '$G(USER),$P($G(^PS(52.85,SITE,0)),"^",2) S Z=^PS(52.85,SITE,0)
I $G(USER),$D(^PS(52.85,SITE,"USER",USER,0)) S Z=^PS(52.85,SITE,"USER",USER,0)
;
I FIELD="EXPDC",VALUE'=$P(Z,"^",2) S PSOCHNG=1 Q
I FIELD="SRTBY",VALUE'=$P(Z,"^",3) S PSOCHNG=1 Q
I FIELD="ORDER",VALUE'=$P(Z,"^",4) S PSOCHNG=1 Q
I FIELD="SIGDP",VALUE'=+$P(Z,"^",5) S PSOCHNG=1 Q
I FIELD="STSGP",VALUE'=+$P(Z,"^",6) S PSOCHNG=1 Q
I FIELD="ORDCNT",VALUE'=+$P(Z,"^",7) S PSOCHNG=1 Q
;
Q
;
;
SET(ZNODE) ;
N X,Y
S X=+$P(ZNODE,"^",2) I X S PSOEXDCE=X,X="T-"_X D ^%DT S PSOEXPDC=Y
S X=$P(ZNODE,"^",3) I X'="" S PSOSRTBY=X
S X=$P(ZNODE,"^",4) I X'="" S PSORDER=X
S X=$P(ZNODE,"^",5) I X'="" S PSOSIGDP=X
S X=$P(ZNODE,"^",6) I X'="" S PSOSTSGP=X
S X=$P(ZNODE,"^",7) I X'="" S PSORDCNT=X
Q
;
SAVE(SITE,USER) ; - Saves preferences by Site and/or User
N DIE,DR,DA
;
W !!,"Saving..."
;
I '$D(^PS(52.85,SITE)) D
. N %,DIC,DR,DA,X,DINUM,DLAYGO,DD,DO
. S DIC="^PS(52.85,",(DINUM,X)=SITE,DIC(0)=""
. K DD,DO D FILE^DICN K DD,DO
;
I $G(USER),'$D(^PS(52.85,SITE,"USER",USER,0)) D
. N %,DIC,DR,DA,X,DINUM,DLAYGO,DD,DO
. S DIC="^PS(52.85,"_SITE_",""USER"",",DA(1)=SITE,(DINUM,X)=USER,DIC(0)=""
. K DD,DO D FILE^DICN K DD,DO
;
S DR="1///"_PSOEXDCE_";2///"_PSOSRTBY_";3///"_PSORDER
S DR=DR_";4///"_PSOSIGDP_";5///"_PSOSTSGP_";6///"_PSORDCNT
;
I '$G(USER) S DIE="^PS(52.85,",DA=SITE
I $G(USER) S DIE="^PS(52.85,"_SITE_",""USER"",",DA(1)=SITE,DA=USER
;
D ^DIE H 2 W "OK!"
;
Q
;
DELETE(SITE,USER) ; - Deletes user/division preferences
N DIK,DA,DIE,DR,FLD
;
W !!,"Deleting..."
;
I '$G(SITE) Q
I $G(USER) S DIK="^PS(52.85,"_SITE_",""USER"",",DA(1)=SITE,DA=USER D ^DIK H 1 W "OK!" Q
I '$D(^PS(52.85,SITE,"USER")) S DIK="^PS(52.85,",DA=SITE D ^DIK H 1 W "OK!" Q
S DR="" F FLD=1:1:8 S $P(DR,";",FLD)=FLD_"///@"
S DIE="^PS(52.85,",DA=SITE D ^DIE H 1 W "OK!"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOPMPPF 8330 printed Sep 23, 2025@20:09:11 Page 2
PSOPMPPF ;BIRM/MFR - Patient Medication Profile - Preferences ;04/28/05
+1 ;;7.0;OUTPATIENT PHARMACY;**260,427**;DEC 1997;Build 21
+2 ;
EN ; - Menu option entry point
+1 NEW PSOCHNG,PSOQUIT,DIR,DIRUT,DIROUT
+2 IF '$GET(PSOSITE)
DO ^PSOLSET
IF '$DATA(PSOPAR)
WRITE $CHAR(7),!!,"Pharmacy Division Must be Selected!",!
QUIT
+3 ;
+4 DO LOAD(PSOSITE)
DO LST(PSOSITE)
+5 IF '$GET(PSOQUIT)
IF $GET(PSOCHNG)
DO SAVE(PSOSITE)
+6 ;
+7 GOTO END
+8 ;
LST(PSOSITE,PSOUSER) ; - Listmanager entry point
+1 NEW DIR,DIRUT,DIROUT
+2 SET (PSOCHNG,PSOQUIT)=0
SET PSOUSER=+$GET(PSOUSER)
DO FULL^VALM1
WRITE !
+3 ;
+4 ; - Reset user/division preferences
+5 IF (PSOUSER&$DATA(^PS(52.85,PSOSITE,"USER",PSOUSER)))!('PSOUSER&($$GET1^DIQ(52.85,PSOSITE,1)'=""))
Begin DoDot:1
+6 DO DISPLAY(PSOSITE,PSOUSER)
+7 SET DIR("A")=" Delete this default view? "
+8 SET DIR(0)="YA"
SET DIR("B")="NO"
DO ^DIR
IF $DATA(DIRUT)!$DATA(DIROUT)
SET PSOQUIT=1
QUIT
+9 IF Y=1
DO DELETE(PSOSITE,PSOUSER)
DO LOAD(PSOSITE,PSOUSER)
+10 WRITE !
End DoDot:1
+11 IF '$TEST
WRITE !,"Division: ",$$GET1^DIQ(59,PSOSITE,.01),!
+12 IF PSOQUIT
QUIT
+13 ;
EXPDC ; - Expiration/Discontinued Cutoff Date
+1 KILL DIR,DIRUT,DIROUT,SAVEX
+2 SET DIR(0)="NA^0:9999"
SET DIR("A")="EXP/CANCEL CUTOFF: "
SET DIR("B")=PSOEXDCE
+3 SET DIR("?",1)="Enter the maximum number of days for an expired and/or"
+4 SET DIR("?")="discontinued prescription to be cut from the profile."
+5 DO ^DIR
IF $DATA(DIRUT)!$DATA(DIROUT)
GOTO @$$GOTO(X,"EXPDC")
+6 WRITE " DAYS"
SET PSOEXDCE=X
SET X="T"_$SELECT(X:"-"_X,1:"")
DO ^%DT
SET PSOEXPDC=Y
+7 DO CHANGED(PSOSITE,PSOUSER,"EXPDC",PSOEXDCE)
+8 ;
SRTBY ; - Sort By
+1 KILL DIR,DIRUT,DIROUT
+2 SET DIR(0)="SA^RX:Rx#;DR:DRUG NAME;ID:ISSUE DATE;LF:LAST FILL DATE"
SET DIR("B")=PSOSRTBY
+3 SET DIR("A")="SORT BY: "
DO ^DIR
IF $DATA(DIRUT)!$DATA(DIROUT)
GOTO @$$GOTO(X,"SRTBY")
+4 SET PSOSRTBY=Y
DO CHANGED(PSOSITE,PSOUSER,"SRTBY",PSOSRTBY)
+5 ;
ORDER ; - Sort Order
+1 KILL DIR,DIRUT,DIROUT
+2 SET DIR(0)="SA^A:ASCENDING;D:DESCENDING"
SET DIR("B")=$SELECT(PSORDER="A":"ASCENDING",1:"DESCENDING")
+3 SET DIR("A")="SORT ORDER: "
DO ^DIR
IF $DATA(DIRUT)!$DATA(DIROUT)
GOTO @$$GOTO(X,"ORDER")
+4 SET PSORDER=Y
DO CHANGED(PSOSITE,PSOUSER,"ORDER",PSORDER)
+5 ;
SIGDP ; - Display SIG
+1 KILL DIR,DIRUT,DIROUT
+2 SET DIR(0)="SA^ON:ON;OFF:OFF"
SET DIR("B")=$SELECT(PSOSIGDP=1:"ON",1:"OFF")
+3 SET DIR("A")="DISPLAY SIG: "
DO ^DIR
IF $DATA(DIRUT)!$DATA(DIROUT)
GOTO @$$GOTO(X,"SIGDP")
+4 SET Y=$SELECT(X="ON":1,1:0)
SET PSOSIGDP=Y
DO CHANGED(PSOSITE,PSOUSER,"SIGDP",PSOSIGDP)
+5 ;
STSGP ; - Group By Status
+1 KILL DIR,DIRUT,DIROUT
+2 SET DIR(0)="SA^ON:ON;OFF:OFF"
SET DIR("B")=$SELECT(PSOSTSGP=1:"ON",1:"OFF")
+3 SET DIR("A")="GROUP BY STATUS: "
DO ^DIR
IF $DATA(DIRUT)!$DATA(DIROUT)
GOTO @$$GOTO(X,"STSGP")
+4 SET Y=$SELECT(X="ON":1,1:0)
SET PSOSTSGP=Y
DO CHANGED(PSOSITE,PSOUSER,"STSGP",PSOSTSGP)
+5 ;
ORDCNT ; - Display Order Count
+1 KILL DIR,DIRUT,DIROUT
+2 SET DIR(0)="SA^ON:ON;OFF:OFF"
SET DIR("B")=$SELECT(PSORDCNT=1:"ON",1:"OFF")
+3 SET DIR("A")="DISPLAY ORDER COUNT: "
DO ^DIR
IF $DATA(DIRUT)!$DATA(DIROUT)
GOTO @$$GOTO(X,"ORDCNT")
+4 SET Y=$SELECT(X="ON":1,1:0)
SET PSORDCNT=Y
DO CHANGED(PSOSITE,PSOUSER,"ORDCNT",PSORDCNT)
+5 ;
EXIT ; Exit
+1 ;
+2 ; - Save view?
+3 IF $GET(PSOCHNG)
IF PSOUSER
Begin DoDot:1
+4 WRITE !
SET DIR(0)="YA"
SET DIR("B")="NO"
SET DIR("A")="Save as your default View? "
+5 DO ^DIR
IF $DATA(DIRUT)!$DATA(DIROUT)!(Y=0)
QUIT
+6 DO SAVE(PSOSITE,PSOUSER)
End DoDot:1
+7 ;
+8 SET VALMBCK="R"
+9 ;
END QUIT
+1 ;
DISPLAY(SITE,USER) ; - Displays the current view
+1 NEW X,Z,FLG,LN
+2 SET (X,Z,FLG)=""
+3 IF $GET(USER)
IF $DATA(^PS(52.85,SITE,"USER",+$GET(USER)))
Begin DoDot:1
+4 SET X=$$GET1^DIQ(200,USER,.01)
SET Z=^PS(52.85,SITE,"USER",+$GET(USER),0)
SET FLG=1
End DoDot:1
+5 IF '$TEST
Begin DoDot:1
+6 SET X=$$GET1^DIQ(59,SITE,.01)
SET Z=$GET(^PS(52.85,SITE,0))
End DoDot:1
+7 IF Z=""
QUIT
+8 SET X=X_"'s current default view"_$SELECT(FLG:" ("_$$GET1^DIQ(59,SITE,.01)_")",1:"")_":"
+9 SET $PIECE(LN,"-",$LENGTH(X))=""
WRITE !?5,X,!?5,LN
+10 WRITE !?5,"EXP/CANCEL CUTOFF : ",$PIECE(Z,"^",2)," DAYS"
+11 SET X=$PIECE(Z,"^",3)
WRITE !?5,"SORT BY : "
+12 WRITE $SELECT(X="RX":"Rx#",X="DR":"DRUG NAME",X="ID":"ISSUE DATE",X="LF":"LAST FILL DATE",1:"??")
+13 WRITE !?5,"SORT ORDER : ",$SELECT($PIECE(Z,"^",4)="A":"ASCENDING",1:"DESCENDING")
+14 WRITE !?5,"DISPLAY SIG : ",$SELECT($PIECE(Z,"^",5):"ON",1:"OFF")
+15 WRITE !?5,"GROUP BY STATUS : ",$SELECT($PIECE(Z,"^",6):"ON",1:"OFF")
+16 WRITE !?5,"DISPLAY ORDER COUNT: ",$SELECT($PIECE(Z,"^",7):"ON",1:"OFF")
+17 WRITE !
+18 QUIT
+19 ;
GOTO(INPUT,HOME) ; - Directed up-arrow
+1 NEW GOTO,TAG,TRGT
+2 IF $PIECE(INPUT,"^",2)=""
SET PSOQUIT=1
QUIT "EXIT"
+3 ;
+4 SET TRGT=$PIECE(INPUT,"^",2)
+5 SET TAG("EXP/CANCEL CUTOFF")="EXPDC"
+6 SET TAG("SORT BY")="SRTBY"
+7 SET TAG("SORT ORDER")="ORDER"
+8 SET TAG("DISPLAY SIG")="SIGDP"
+9 SET TAG("GROUP BY STATUS")="STSGP"
+10 SET TAG("DISPLAY ORDER COUNT")="ORDCNT"
+11 ;
+12 SET GOTO=HOME
+13 SET TAG=""
FOR
SET TAG=$ORDER(TAG(TAG))
if TAG=""
QUIT
IF $EXTRACT(TAG,1,$LENGTH(TRGT))=TRGT
SET GOTO=TAG(TAG)
QUIT
+14 IF GOTO=HOME
WRITE " ??",$CHAR(7)
+15 ;
+16 QUIT GOTO
+17 ;
LOAD(SITE,USER) ; Loading Factory/Division/User preferences
+1 ;Input : SITE - Pointer to OUTPATIENT SITE file (#59)
+2 ; USER - Pointer to NEW PSERON file (#200)
+3 ;Output: PSOEXPDC - Expiration Cutoff Date
+4 ; PSOEXDCE - Expiration Cutoff Date (External)
+5 ; PSOSRTBY - Sort By
+6 ; PSORDER - Sort Order ("A":Asc,"D":Desc)
+7 ; PSOSIGDP - Display SIG (1:ON/0:OFF)
+8 ; PSORDCNT - Display Order Count (1:ON/0:OFF)
+9 ; PSOSTSGP - Group by Status (1:ON/0:OFF)
+10 ; PSOSTSEQ - Status Display Order Array
+11 ; PSORDSEQ - Group Display Order Array
+12 ;
+13 KILL PSOEXPDC,PSOEXDCE,PSOSRTBY,PSORDER,PSOSTSGP,PSOSIGDP,PSOSTSEQ,PSORDSEQ
+14 ;
+15 NEW X,Y,Z,TMP,STSGRP,STS,ORDGRP,GRPNAM
+16 ;
+17 ; - Factory Defaults
+18 SET PSOEXDCE=120
SET X="T-120"
DO ^%DT
SET PSOEXPDC=Y
+19 SET PSOSRTBY="DR"
SET PSORDER="A"
SET PSORDCNT=1
SET (PSOSTSGP,PSOSIGDP)=0
+20 ;
+21 ; Active
SET PSOSTSEQ("A")="1^ACTIVE^A"
+22 ; Suspended
SET PSOSTSEQ("S")="1^ACTIVE^S"
+23 ; Expired
SET PSOSTSEQ("E")="1^ACTIVE^E"
+24 ; Discontinued
SET PSOSTSEQ("DC")="2^DISCONTINUED^DC"
+25 ; Discontinued by Provider
SET PSOSTSEQ("DP")="2^DISCONTINUED^DP"
+26 ; Discontinued on Edit
SET PSOSTSEQ("DE")="2^DISCONTINUED^DE"
+27 ; Hold
SET PSOSTSEQ("H")="3^HOLD^H"
+28 ; Provider Hold
SET PSOSTSEQ("PH")="3^HOLD^PH"
+29 ; Non-Verified
SET PSOSTSEQ("N")="4^NON-VERIFIED^N"
+30 ;
+31 SET PSORDSEQ("T")="1^REFILL TOO SOON/DUR REJECTS (Third Party)"
+32 ; added for *427
SET PSORDSEQ("H")="2^OTHER REJECTS PENDING RESOLUTION"
+33 SET PSORDSEQ("R")="3^CURRENT ORDERS"
+34 SET PSORDSEQ("P")="4^PENDING"
+35 SET PSORDSEQ("N")="5^NON-VA MEDS (Not dispensed by VA)"
+36 ;
+37 ; - User's preferences
+38 IF $GET(USER)
IF $DATA(^PS(52.85,SITE,"USER",USER,0))
DO SET(^PS(52.85,SITE,"USER",USER,0))
QUIT
+39 ;
+40 ; - Division's preferences
+41 IF $DATA(^PS(52.85,SITE,0))
DO SET(^PS(52.85,SITE,0))
QUIT
+42 ;
+43 QUIT
+44 ;
CHANGED(SITE,USER,FIELD,VALUE) ; - Sets PSOCHNG so the list can be refreshed
+1 IF $GET(PSOCHNG)
QUIT
+2 ;
+3 ; - Saved User's preferences
+4 SET Z=""
+5 IF '$GET(USER)
IF $PIECE($GET(^PS(52.85,SITE,0)),"^",2)
SET Z=^PS(52.85,SITE,0)
+6 IF $GET(USER)
IF $DATA(^PS(52.85,SITE,"USER",USER,0))
SET Z=^PS(52.85,SITE,"USER",USER,0)
+7 ;
+8 IF FIELD="EXPDC"
IF VALUE'=$PIECE(Z,"^",2)
SET PSOCHNG=1
QUIT
+9 IF FIELD="SRTBY"
IF VALUE'=$PIECE(Z,"^",3)
SET PSOCHNG=1
QUIT
+10 IF FIELD="ORDER"
IF VALUE'=$PIECE(Z,"^",4)
SET PSOCHNG=1
QUIT
+11 IF FIELD="SIGDP"
IF VALUE'=+$PIECE(Z,"^",5)
SET PSOCHNG=1
QUIT
+12 IF FIELD="STSGP"
IF VALUE'=+$PIECE(Z,"^",6)
SET PSOCHNG=1
QUIT
+13 IF FIELD="ORDCNT"
IF VALUE'=+$PIECE(Z,"^",7)
SET PSOCHNG=1
QUIT
+14 ;
+15 QUIT
+16 ;
+17 ;
SET(ZNODE) ;
+1 NEW X,Y
+2 SET X=+$PIECE(ZNODE,"^",2)
IF X
SET PSOEXDCE=X
SET X="T-"_X
DO ^%DT
SET PSOEXPDC=Y
+3 SET X=$PIECE(ZNODE,"^",3)
IF X'=""
SET PSOSRTBY=X
+4 SET X=$PIECE(ZNODE,"^",4)
IF X'=""
SET PSORDER=X
+5 SET X=$PIECE(ZNODE,"^",5)
IF X'=""
SET PSOSIGDP=X
+6 SET X=$PIECE(ZNODE,"^",6)
IF X'=""
SET PSOSTSGP=X
+7 SET X=$PIECE(ZNODE,"^",7)
IF X'=""
SET PSORDCNT=X
+8 QUIT
+9 ;
SAVE(SITE,USER) ; - Saves preferences by Site and/or User
+1 NEW DIE,DR,DA
+2 ;
+3 WRITE !!,"Saving..."
+4 ;
+5 IF '$DATA(^PS(52.85,SITE))
Begin DoDot:1
+6 NEW %,DIC,DR,DA,X,DINUM,DLAYGO,DD,DO
+7 SET DIC="^PS(52.85,"
SET (DINUM,X)=SITE
SET DIC(0)=""
+8 KILL DD,DO
DO FILE^DICN
KILL DD,DO
End DoDot:1
+9 ;
+10 IF $GET(USER)
IF '$DATA(^PS(52.85,SITE,"USER",USER,0))
Begin DoDot:1
+11 NEW %,DIC,DR,DA,X,DINUM,DLAYGO,DD,DO
+12 SET DIC="^PS(52.85,"_SITE_",""USER"","
SET DA(1)=SITE
SET (DINUM,X)=USER
SET DIC(0)=""
+13 KILL DD,DO
DO FILE^DICN
KILL DD,DO
End DoDot:1
+14 ;
+15 SET DR="1///"_PSOEXDCE_";2///"_PSOSRTBY_";3///"_PSORDER
+16 SET DR=DR_";4///"_PSOSIGDP_";5///"_PSOSTSGP_";6///"_PSORDCNT
+17 ;
+18 IF '$GET(USER)
SET DIE="^PS(52.85,"
SET DA=SITE
+19 IF $GET(USER)
SET DIE="^PS(52.85,"_SITE_",""USER"","
SET DA(1)=SITE
SET DA=USER
+20 ;
+21 DO ^DIE
HANG 2
WRITE "OK!"
+22 ;
+23 QUIT
+24 ;
DELETE(SITE,USER) ; - Deletes user/division preferences
+1 NEW DIK,DA,DIE,DR,FLD
+2 ;
+3 WRITE !!,"Deleting..."
+4 ;
+5 IF '$GET(SITE)
QUIT
+6 IF $GET(USER)
SET DIK="^PS(52.85,"_SITE_",""USER"","
SET DA(1)=SITE
SET DA=USER
DO ^DIK
HANG 1
WRITE "OK!"
QUIT
+7 IF '$DATA(^PS(52.85,SITE,"USER"))
SET DIK="^PS(52.85,"
SET DA=SITE
DO ^DIK
HANG 1
WRITE "OK!"
QUIT
+8 SET DR=""
FOR FLD=1:1:8
SET $PIECE(DR,";",FLD)=FLD_"///@"
+9 SET DIE="^PS(52.85,"
SET DA=SITE
DO ^DIE
HANG 1
WRITE "OK!"
+10 QUIT
