- 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 Feb 18, 2025@23:59:12 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