- PSIVSET ;BIR/PR-IV PACKAGE ENTRY POINT ;12 DEC 97 / 9:18 AM
- ;;5.0;INPATIENT MEDICATIONS;**35,81,91,407**;16 DEC 1997;Build 26
- ;
- ; Reference to ^PS(59.7 is supported by DBIA# 2181.
- ;
- ; PSJ*407 - Liberty ITS/RJH - 08/22 - Significant modifications to prevent
- ; users from being allowed to update the IV Room file (#59.5)
- ; without the PSJI MGR security key
- ;
- D NOW^%DTC S Y=%
- ;W !!,"INPATIENT MEDICATIONS (IV) (Version: ",$P($P($T(PSIVSET+1),";;",2)," ",1,2),")",!
- ENOR ;
- S (PSIVCT,PSIVSN)=0 D NOW^%DTC F X=0:0 S X=$O(^PS(59.5,X)) Q:'X D
- .I $S(+'$G(^PS(59.5,X,"I")):1,+$G(^PS(59.5,X,"I"))>%:1,1:0) S PSIVCT=PSIVCT+1 S PSIVSN=X
- I PSIVCT=1 D ENCHK I $D(%) S:%=-1!(%=2) XQUIT="" G:%=2!(%=-1) Q1
- ;I PSIVCT=1 S PSIVSN=$O(^PS(59.5,0)) D ENCHK I $D(%) S:%=-1!(%=2) XQUIT="" G:%=2!(%=-1) Q1
- MULT ;
- ; PSJ*407/RJH - Begin changes
- ; I PSIVCT>1 K DIC S DIC="^PS(59.5,",DIC(0)="QEAM",DIC("S")="I $S($P($G(^(""I"")),U)="""":1,1:$P(^(""I""),U)>DT)" D ^DIC K DIC S:Y<0 XQUIT="" Q:Y<0 S PSIVSN=+Y D ENCHK I $D(%) G:%=2 MULT S:%=-1 XQUIT="" G:%=-1 Q1
- I PSIVCT>1 D
- . I '$D(^TMP("PSJUSER",$J,"FLAG")) D Q
- .. K DIC S DIC="^PS(59.5,",DIC(0)="QEAM",DIC("S")="I $S($P($G(^(""I"")),U)="""":1,1:$P(^(""I""),U)>DT)" D ^DIC K DIC
- .. S:Y<0 XQUIT="" Q:Y<0
- .. S PSIVSN=+Y D ENCHK I $D(%) G:%=2 MULT S:%=-1 XQUIT="" G:%=-1 Q1
- .. Q
- . S PSIVSN=$G(^TMP("PSJUSER",$J,"FLAG")) D ENCHK I $D(%) G:%=2 MULT S:%=-1 XQUIT="" G:%=-1 Q1
- . Q
- ;
- Q:+$G(DONE)=1 ;P407
- ; PSJ*407/RJH - End changes
- I 'PSIVCT W !!,"Whoops ... You don't have an IV ROOM defined ... ",!,"You MUST define at least one IV ROOM before you can continue.",! S DIC="^PS(59.5,",DIC(0)="QEAML",DLAYGO=59.5,DIC("A")="Select IV ROOM: " D ^DIC I Y'>0 S XQUIT="" G Q1
- I 'PSIVCT S DIE=DIC,(DA,PSIVSN)=+Y,DR="[PSJI SITE PARAMETERS]" K DIC D ^DIE,ENCHK
- Q ;
- I PSIVSN<1 W !!,"You have not selected a valid IV ROOM" S %=1 D YN^DICN I %=0 G Q
- I PSIVSN<1 G:%=1 PSIVSET S XQUIT="" G Q1
- S IOP=$P(^PS(59.5,PSIVSN,0),U,2) I IOP]"" S %ZIS="QN" D ^%ZIS I ION]"" W !!,"Current IV LABEL device is: ",ION S PSIVPL=ION
- E D ENLD
- S IOP=$P(^PS(59.5,PSIVSN,0),U,3) I IOP]"" S %ZIS="QN" D ^%ZIS I ION]"" W !!,"Current IV REPORT device is: ",ION S PSIVPR=ION
- E D ENPD
- ;D ^%ZISC - check if %ZISC created mismatch in PSIVPL/PSIVPR = ION; don't que later
- D ^%ZISC S:PSIVPL="HOME" PSIVPL=ION S:PSIVPR="HOME" PSIVPR=ION
- Q1 K IOP,PSIVCT,%ZIS,% Q
- ;
- ENCHK ;
- ; PSJ*407/RJH - Begin changes
- N OPT1,OPTS ; PSJ*407
- D SETUP ; PSJ*407
- S DONE=0 ; PSJ*407
- S OPT1=$P($G(XQY0),U,1) ; PSJ*407 - This should be the calling menu option
- ;
- S PSIV=1 S:'$D(^PS(59.5,PSIVSN,5)) $P(^(5),U)="" I '$D(^PS(59.5,PSIVSN,1)) S PSIV=0 W !!,$C(7),"This IV room is missing parameters."
- E S PSIVSITE=^PS(59.5,PSIVSN,1),$P(PSIVSITE,U,20,21)=$G(^PS(59.5,PSIVSN,5)) D
- .; F TYP="A","P","H","S","C" I '$D(^PS(59.5,PSIVSN,2,"AC",TYP)) W !!,$C(7),"Manufacturing Time(s) missing for " S X=$$CODES^PSIVUTL(TYP,59.51,.02) W X S PSIV=0 ; PSJ*407
- . F TYP="A","P","H","S","C" I '$D(^PS(59.5,PSIVSN,2,"AC",TYP)),'$D(^TMP("PSJUSER",$J,"DSPFLAG")) S PSIV=0 S ^TMP("PSJUSER",$J,"FLAG")=PSIVSN D ; PSJ*407
- . Q ; PSJ*407
- AGA ;
- ; I 'PSIV R !!,"Would you like to edit this IV room" S %=1 D YN^DICN Q:%=2!(%=-1) W:'% !,"Answer Yes or No.",! G:'% AGA S DIE="^PS(59.5,",DR="[PSJI SITE PARAMETERS]",DA=PSIVSN D ^DIE G ENCHK ; PSJ*407
- ; I PSIVSN W !!,"You are signed on under the ",$P(^PS(59.5,PSIVSN,0),"^")," IV ROOM" K % ; PSJ*407
- I PSIVSN,PSIV D Q ; The IV Room is defined and set up properly
- . W !!,"You are signed on under the ",$P(^PS(59.5,PSIVSN,0),"^")," IV ROOM" K %
- . K PSIV,TYP,%X,%Y,C,D,D0,D1,DA,DIC,DIE,DR,X,Y,Z
- . Q
- ;
- ; If we're here, then the IV Room is missing Coverages
- I OPT1="PSJI SITE PARAMETERS" D SITEMSG Q
- ; I '$D(^TMP("PSJUSER",$J,"DSPFLAG")),(OPT1="PSJI MGR"),($G(XQY0)'["PSJI SUPERVISOR") D MSG1(1) Q
- I '$D(^TMP("PSJUSER",$J,"SUPFLAG")),(OPT1="PSJI MGR")!(OPT1="PSJI SUPERVISOR") D MSG1(1) Q
- I $D(OPTS(OPT1)) D MSG1(0) Q
- ; K PSIV,TYP,%X,%Y,C,D,D0,D1,DA,DIC,DIE,DR,X,Y,Z Q ; PSJ*407
- Q
- ; PSJ*407/RJH - End changes
- ;
- ENLD ;Get label device.
- W ! K IOP S %ZIS="NQ",%ZIS("B")=$S($P(^PS(59.5,PSIVSN,0),U,2)]"":$P(^(0),U,2),1:"HOME"),%ZIS("A")="Enter IV LABEL device: " D ^%ZIS S:POP ION="HOME"
- S PSIVPL=ION K IOP,%ZIS Q
- ENPD ;Get printer device.
- W ! K IOP S %ZIS("B")=$S($P(^PS(59.5,PSIVSN,0),U,3)]"":$P(^(0),U,3),1:"HOME"),%ZIS="NQ",%ZIS("A")="Enter IV REPORT device: " D ^%ZIS S:POP ION="HOME"
- S PSIVPR=ION K IOP,%ZIS Q
- DEVX W !!,$C(7),"You must select a device."
- Q
- SITEPARM ; Edit IV Site Parameters.
- D ^PSIVXU Q:$D(XQUIT)
- N CHK,DIC,DIE,DA,DR,DLAYGO,DIOV,DTOUT,PSGDT,Z
- S DIC=59.7,DIC(0)="AEMQ" D ^DIC Q:Y<0
- S DIE=DIC,DA=+Y,DR=32 D ^DIE
- D ^PSIVXU Q:$D(XQUIT) S (DIC,DLAYGO)=59.5,DIC(0)="AEQMLZ" D ^DIC S:Y>0 DIE=DIC,DA=+Y,DR="[PSJI SITE PARAMETERS]" D:Y>0 ^DIE,ENCHK^PSIVSET,SET^PSIVXU D ENIVKV^PSGSETU
- ; ----------------------------------------------------------------------------
- ; PSJ*407/RJH - Begin changes
- ; Added Quit to SITEPARM tag and new tags below
- Q
- SITEMSG ;
- D MISSING
- W !,!,"Please select "_$P(^PS(59.5,PSIVSN,0),U,1)_" IV ROOM to update the Parameters."
- W ! K DIR S DIR(0)="E",DIR("A")="Press Return to Continue" D ^DIR K DIR,DTOUT,DUOUT,DIRUT
- S ^TMP("PSJUSER",$J,"DSPFLAG")=1
- K PSIV,TYP,%X,%Y,C,D,D0,D1,DA,DIC,DIE,DR,X,Y,Z
- Q
- ;
- MSG1(FLG) ;
- D MISSING
- W !,!,"The "_$P(^PS(59.5,PSIVSN,0),U,1)_" IV ROOM can be updated using option 'Site Parameters (IV)'"
- W !,"by a holder of the PSJI MGR VistA Security Key. Contact the"
- W !,"Pharmacy Informaticist to update the IV Room parameters."
- I 'FLG W !!,"You are being returned to the Option Menu." S DONE=1
- W ! K DIR S DIR(0)="E",DIR("A")="Press Return to Continue" D ^DIR K DIR,DTOUT,DUOUT,DIRUT
- I FLG S ^TMP("PSJUSER",$J,"SUPFLAG")=1
- K PSIV,TYP,%X,%Y,C,D,D0,D1,DA,DIC,DIE,DR,X,Y,Z
- Q
- ;
- MISSING ; Show the missing coverage time(s)
- F TYP="A","P","H","S","C" I '$D(^PS(59.5,PSIVSN,2,"AC",TYP)) D
- . W !!,$C(7),"Coverage Time(s) missing for " S X=$$CODES^PSIVUTL(TYP,59.51,.02) W X
- . Q
- Q
- ;
- SETUP ; Menu options to check to display missing coverage warnings to the user
- ; S OPTS(Menu option from #19)="". Menu option is piece one of XQY0
- S OPTS("PSJI RETURN BY BARCODE ID")=""
- S OPTS("PSJI LBLMENU")=""
- S OPTS("PSJI LBLI")=""
- S OPTS("PSJI MAN")=""
- S OPTS("PSJI ORDER")=""
- S OPTS("PSJI RETURNS")=""
- S OPTS("PSJI SUSMENU")=""
- S OPTS("PSJI SUSLBDEL")=""
- S OPTS("PSJI INDIVIDUAL SUSPENSE")=""
- S OPTS("PSJI SUSLBLS")=""
- S OPTS("PSJI SUSMAN")=""
- S OPTS("PSJI SUSREP")=""
- S OPTS("PSJI SUSLIST")=""
- S OPTS("PSJU VBW")=""
- S OPTS("PSJ ECO")=""
- S OPTS("PSJ OE")=""
- Q
- ; PSJ*407/RJH - End changes
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSIVSET 6847 printed Feb 18, 2025@23:31:26 Page 2
- PSIVSET ;BIR/PR-IV PACKAGE ENTRY POINT ;12 DEC 97 / 9:18 AM
- +1 ;;5.0;INPATIENT MEDICATIONS;**35,81,91,407**;16 DEC 1997;Build 26
- +2 ;
- +3 ; Reference to ^PS(59.7 is supported by DBIA# 2181.
- +4 ;
- +5 ; PSJ*407 - Liberty ITS/RJH - 08/22 - Significant modifications to prevent
- +6 ; users from being allowed to update the IV Room file (#59.5)
- +7 ; without the PSJI MGR security key
- +8 ;
- +9 DO NOW^%DTC
- SET Y=%
- +10 ;W !!,"INPATIENT MEDICATIONS (IV) (Version: ",$P($P($T(PSIVSET+1),";;",2)," ",1,2),")",!
- ENOR ;
- +1 SET (PSIVCT,PSIVSN)=0
- DO NOW^%DTC
- FOR X=0:0
- SET X=$ORDER(^PS(59.5,X))
- if 'X
- QUIT
- Begin DoDot:1
- +2 IF $SELECT(+'$GET(^PS(59.5,X,"I")):1,+$GET(^PS(59.5,X,"I"))>%:1,1:0)
- SET PSIVCT=PSIVCT+1
- SET PSIVSN=X
- End DoDot:1
- +3 IF PSIVCT=1
- DO ENCHK
- IF $DATA(%)
- if %=-1!(%=2)
- SET XQUIT=""
- if %=2!(%=-1)
- GOTO Q1
- +4 ;I PSIVCT=1 S PSIVSN=$O(^PS(59.5,0)) D ENCHK I $D(%) S:%=-1!(%=2) XQUIT="" G:%=2!(%=-1) Q1
- MULT ;
- +1 ; PSJ*407/RJH - Begin changes
- +2 ; I PSIVCT>1 K DIC S DIC="^PS(59.5,",DIC(0)="QEAM",DIC("S")="I $S($P($G(^(""I"")),U)="""":1,1:$P(^(""I""),U)>DT)" D ^DIC K DIC S:Y<0 XQUIT="" Q:Y<0 S PSIVSN=+Y D ENCHK I $D(%) G:%=2 MULT S:%=-1 XQUIT="" G:%=-1 Q1
- +3 IF PSIVCT>1
- Begin DoDot:1
- +4 IF '$DATA(^TMP("PSJUSER",$JOB,"FLAG"))
- Begin DoDot:2
- +5 KILL DIC
- SET DIC="^PS(59.5,"
- SET DIC(0)="QEAM"
- SET DIC("S")="I $S($P($G(^(""I"")),U)="""":1,1:$P(^(""I""),U)>DT)"
- DO ^DIC
- KILL DIC
- +6 if Y<0
- SET XQUIT=""
- if Y<0
- QUIT
- +7 SET PSIVSN=+Y
- DO ENCHK
- IF $DATA(%)
- if %=2
- GOTO MULT
- if %=-1
- SET XQUIT=""
- if %=-1
- GOTO Q1
- +8 QUIT
- End DoDot:2
- QUIT
- +9 SET PSIVSN=$GET(^TMP("PSJUSER",$JOB,"FLAG"))
- DO ENCHK
- IF $DATA(%)
- if %=2
- GOTO MULT
- if %=-1
- SET XQUIT=""
- if %=-1
- GOTO Q1
- +10 QUIT
- End DoDot:1
- +11 ;
- +12 ;P407
- if +$GET(DONE)=1
- QUIT
- +13 ; PSJ*407/RJH - End changes
- +14 IF 'PSIVCT
- WRITE !!,"Whoops ... You don't have an IV ROOM defined ... ",!,"You MUST define at least one IV ROOM before you can continue.",!
- SET DIC="^PS(59.5,"
- SET DIC(0)="QEAML"
- SET DLAYGO=59.5
- SET DIC("A")="Select IV ROOM: "
- DO ^DIC
- IF Y'>0
- SET XQUIT=""
- GOTO Q1
- +15 IF 'PSIVCT
- SET DIE=DIC
- SET (DA,PSIVSN)=+Y
- SET DR="[PSJI SITE PARAMETERS]"
- KILL DIC
- DO ^DIE
- DO ENCHK
- Q ;
- +1 IF PSIVSN<1
- WRITE !!,"You have not selected a valid IV ROOM"
- SET %=1
- DO YN^DICN
- IF %=0
- GOTO Q
- +2 IF PSIVSN<1
- if %=1
- GOTO PSIVSET
- SET XQUIT=""
- GOTO Q1
- +3 SET IOP=$PIECE(^PS(59.5,PSIVSN,0),U,2)
- IF IOP]""
- SET %ZIS="QN"
- DO ^%ZIS
- IF ION]""
- WRITE !!,"Current IV LABEL device is: ",ION
- SET PSIVPL=ION
- +4 IF '$TEST
- DO ENLD
- +5 SET IOP=$PIECE(^PS(59.5,PSIVSN,0),U,3)
- IF IOP]""
- SET %ZIS="QN"
- DO ^%ZIS
- IF ION]""
- WRITE !!,"Current IV REPORT device is: ",ION
- SET PSIVPR=ION
- +6 IF '$TEST
- DO ENPD
- +7 ;D ^%ZISC - check if %ZISC created mismatch in PSIVPL/PSIVPR = ION; don't que later
- +8 DO ^%ZISC
- if PSIVPL="HOME"
- SET PSIVPL=ION
- if PSIVPR="HOME"
- SET PSIVPR=ION
- Q1 KILL IOP,PSIVCT,%ZIS,%
- QUIT
- +1 ;
- ENCHK ;
- +1 ; PSJ*407/RJH - Begin changes
- +2 ; PSJ*407
- NEW OPT1,OPTS
- +3 ; PSJ*407
- DO SETUP
- +4 ; PSJ*407
- SET DONE=0
- +5 ; PSJ*407 - This should be the calling menu option
- SET OPT1=$PIECE($GET(XQY0),U,1)
- +6 ;
- +7 SET PSIV=1
- if '$DATA(^PS(59.5,PSIVSN,5))
- SET $PIECE(^(5),U)=""
- IF '$DATA(^PS(59.5,PSIVSN,1))
- SET PSIV=0
- WRITE !!,$CHAR(7),"This IV room is missing parameters."
- +8 IF '$TEST
- SET PSIVSITE=^PS(59.5,PSIVSN,1)
- SET $PIECE(PSIVSITE,U,20,21)=$GET(^PS(59.5,PSIVSN,5))
- Begin DoDot:1
- +9 ; F TYP="A","P","H","S","C" I '$D(^PS(59.5,PSIVSN,2,"AC",TYP)) W !!,$C(7),"Manufacturing Time(s) missing for " S X=$$CODES^PSIVUTL(TYP,59.51,.02) W X S PSIV=0 ; PSJ*407
- +10 ; PSJ*407
- FOR TYP="A","P","H","S","C"
- IF '$DATA(^PS(59.5,PSIVSN,2,"AC",TYP))
- IF '$DATA(^TMP("PSJUSER",$JOB,"DSPFLAG"))
- SET PSIV=0
- SET ^TMP("PSJUSER",$JOB,"FLAG")=PSIVSN
- Begin DoDot:2
- End DoDot:2
- +11 ; PSJ*407
- QUIT
- End DoDot:1
- AGA ;
- +1 ; I 'PSIV R !!,"Would you like to edit this IV room" S %=1 D YN^DICN Q:%=2!(%=-1) W:'% !,"Answer Yes or No.",! G:'% AGA S DIE="^PS(59.5,",DR="[PSJI SITE PARAMETERS]",DA=PSIVSN D ^DIE G ENCHK ; PSJ*407
- +2 ; I PSIVSN W !!,"You are signed on under the ",$P(^PS(59.5,PSIVSN,0),"^")," IV ROOM" K % ; PSJ*407
- +3 ; The IV Room is defined and set up properly
- IF PSIVSN
- IF PSIV
- Begin DoDot:1
- +4 WRITE !!,"You are signed on under the ",$PIECE(^PS(59.5,PSIVSN,0),"^")," IV ROOM"
- KILL %
- +5 KILL PSIV,TYP,%X,%Y,C,D,D0,D1,DA,DIC,DIE,DR,X,Y,Z
- +6 QUIT
- End DoDot:1
- QUIT
- +7 ;
- +8 ; If we're here, then the IV Room is missing Coverages
- +9 IF OPT1="PSJI SITE PARAMETERS"
- DO SITEMSG
- QUIT
- +10 ; I '$D(^TMP("PSJUSER",$J,"DSPFLAG")),(OPT1="PSJI MGR"),($G(XQY0)'["PSJI SUPERVISOR") D MSG1(1) Q
- +11 IF '$DATA(^TMP("PSJUSER",$JOB,"SUPFLAG"))
- IF (OPT1="PSJI MGR")!(OPT1="PSJI SUPERVISOR")
- DO MSG1(1)
- QUIT
- +12 IF $DATA(OPTS(OPT1))
- DO MSG1(0)
- QUIT
- +13 ; K PSIV,TYP,%X,%Y,C,D,D0,D1,DA,DIC,DIE,DR,X,Y,Z Q ; PSJ*407
- +14 QUIT
- +15 ; PSJ*407/RJH - End changes
- +16 ;
- ENLD ;Get label device.
- +1 WRITE !
- KILL IOP
- SET %ZIS="NQ"
- SET %ZIS("B")=$SELECT($PIECE(^PS(59.5,PSIVSN,0),U,2)]"":$PIECE(^(0),U,2),1:"HOME")
- SET %ZIS("A")="Enter IV LABEL device: "
- DO ^%ZIS
- if POP
- SET ION="HOME"
- +2 SET PSIVPL=ION
- KILL IOP,%ZIS
- QUIT
- ENPD ;Get printer device.
- +1 WRITE !
- KILL IOP
- SET %ZIS("B")=$SELECT($PIECE(^PS(59.5,PSIVSN,0),U,3)]"":$PIECE(^(0),U,3),1:"HOME")
- SET %ZIS="NQ"
- SET %ZIS("A")="Enter IV REPORT device: "
- DO ^%ZIS
- if POP
- SET ION="HOME"
- +2 SET PSIVPR=ION
- KILL IOP,%ZIS
- QUIT
- DEVX WRITE !!,$CHAR(7),"You must select a device."
- +1 QUIT
- SITEPARM ; Edit IV Site Parameters.
- +1 DO ^PSIVXU
- if $DATA(XQUIT)
- QUIT
- +2 NEW CHK,DIC,DIE,DA,DR,DLAYGO,DIOV,DTOUT,PSGDT,Z
- +3 SET DIC=59.7
- SET DIC(0)="AEMQ"
- DO ^DIC
- if Y<0
- QUIT
- +4 SET DIE=DIC
- SET DA=+Y
- SET DR=32
- DO ^DIE
- +5 DO ^PSIVXU
- if $DATA(XQUIT)
- QUIT
- SET (DIC,DLAYGO)=59.5
- SET DIC(0)="AEQMLZ"
- DO ^DIC
- if Y>0
- SET DIE=DIC
- SET DA=+Y
- SET DR="[PSJI SITE PARAMETERS]"
- if Y>0
- DO ^DIE
- DO ENCHK^PSIVSET
- DO SET^PSIVXU
- DO ENIVKV^PSGSETU
- +6 ; ----------------------------------------------------------------------------
- +7 ; PSJ*407/RJH - Begin changes
- +8 ; Added Quit to SITEPARM tag and new tags below
- +9 QUIT
- SITEMSG ;
- +1 DO MISSING
- +2 WRITE !,!,"Please select "_$PIECE(^PS(59.5,PSIVSN,0),U,1)_" IV ROOM to update the Parameters."
- +3 WRITE !
- KILL DIR
- SET DIR(0)="E"
- SET DIR("A")="Press Return to Continue"
- DO ^DIR
- KILL DIR,DTOUT,DUOUT,DIRUT
- +4 SET ^TMP("PSJUSER",$JOB,"DSPFLAG")=1
- +5 KILL PSIV,TYP,%X,%Y,C,D,D0,D1,DA,DIC,DIE,DR,X,Y,Z
- +6 QUIT
- +7 ;
- MSG1(FLG) ;
- +1 DO MISSING
- +2 WRITE !,!,"The "_$PIECE(^PS(59.5,PSIVSN,0),U,1)_" IV ROOM can be updated using option 'Site Parameters (IV)'"
- +3 WRITE !,"by a holder of the PSJI MGR VistA Security Key. Contact the"
- +4 WRITE !,"Pharmacy Informaticist to update the IV Room parameters."
- +5 IF 'FLG
- WRITE !!,"You are being returned to the Option Menu."
- SET DONE=1
- +6 WRITE !
- KILL DIR
- SET DIR(0)="E"
- SET DIR("A")="Press Return to Continue"
- DO ^DIR
- KILL DIR,DTOUT,DUOUT,DIRUT
- +7 IF FLG
- SET ^TMP("PSJUSER",$JOB,"SUPFLAG")=1
- +8 KILL PSIV,TYP,%X,%Y,C,D,D0,D1,DA,DIC,DIE,DR,X,Y,Z
- +9 QUIT
- +10 ;
- MISSING ; Show the missing coverage time(s)
- +1 FOR TYP="A","P","H","S","C"
- IF '$DATA(^PS(59.5,PSIVSN,2,"AC",TYP))
- Begin DoDot:1
- +2 WRITE !!,$CHAR(7),"Coverage Time(s) missing for "
- SET X=$$CODES^PSIVUTL(TYP,59.51,.02)
- WRITE X
- +3 QUIT
- End DoDot:1
- +4 QUIT
- +5 ;
- SETUP ; Menu options to check to display missing coverage warnings to the user
- +1 ; S OPTS(Menu option from #19)="". Menu option is piece one of XQY0
- +2 SET OPTS("PSJI RETURN BY BARCODE ID")=""
- +3 SET OPTS("PSJI LBLMENU")=""
- +4 SET OPTS("PSJI LBLI")=""
- +5 SET OPTS("PSJI MAN")=""
- +6 SET OPTS("PSJI ORDER")=""
- +7 SET OPTS("PSJI RETURNS")=""
- +8 SET OPTS("PSJI SUSMENU")=""
- +9 SET OPTS("PSJI SUSLBDEL")=""
- +10 SET OPTS("PSJI INDIVIDUAL SUSPENSE")=""
- +11 SET OPTS("PSJI SUSLBLS")=""
- +12 SET OPTS("PSJI SUSMAN")=""
- +13 SET OPTS("PSJI SUSREP")=""
- +14 SET OPTS("PSJI SUSLIST")=""
- +15 SET OPTS("PSJU VBW")=""
- +16 SET OPTS("PSJ ECO")=""
- +17 SET OPTS("PSJ OE")=""
- +18 QUIT
- +19 ; PSJ*407/RJH - End changes