- PSJPDV ;BIR/KKA-LIST PATIENTS ON SPECIFIC DRUGS ;01 Mar 99 / 3:18 PM
- ;;5.0; INPATIENT MEDICATIONS ;**9,22,30,50,67**;16 DEC 97
- ;
- ; Reference to ^PS(50.7 is supported by DBIA# 2180.
- ; Reference to ^PS(52.6 is supported by DBIA# 1231.
- ; Reference to ^PS(52.7 is supported by DBIA# 2173.
- ; Reference to ^PS(59.7 is supported by DBIA# 2181.
- ; Reference to ^PSDRUG is supported by DBIA# 2192.
- ; Reference to ^PS(50.606 is supported by DBIA# 2174.
- ; Reference to ^PS(50.605 is supported by DBIA# 696.
- ; Reference to ^%DT is supported by DBIA# 10003.
- ; Reference to ^%ZISC is supported by DBIA# 10089.
- ; Reference to ^DIC is supported by DBIA# 10006.
- ; Reference to ^DIR is supported by DBIA# 10024.
- ;
- DATES ;prompt user for the range of dates
- W ! S %DT="ETX",D="start" D DT G:Y'>0 DONE S (%DT(0),PSJREPS)=+Y,D="stop" D DT K %DT G:Y'>0 DONE S:'$P(PSJREPS,".",2) PSJREPS=PSJREPS+.0001 S PSJREPF=Y+$S($P(Y,".",2):0,1:.24)
- ;
- ORDERS D LIST^PSJEXP0 G:$D(OUT) DONE W !
- ;
- SORT S DIR(0)="SAOM^P:Patient;S:Start Date",DIR("A")="Do you wish to sort by (P)atient or (S)tart Date: ",DIR("B")="Patient"
- S DIR("?",1)="Enter a ""P"" if you wish to sort by patient name or enter ""S"" if you",DIR("?")="wish to sort by order start date." D ^DIR K DIR S PSJSRT=Y G:$D(DTOUT)!($D(DUOUT)) DONE
- ;
- SELECT W ! S DIR(0)="SAM^O:Orderable Item;D:Dispense Drug;V:VA Class of Drugs",DIR("A")="List by (O)rderable Item, (D)ispense Drug, or (V)A Class of Drugs: "
- S DIR("?",1)="Enter a ""O"" if you wish to list all patients on a specific orderable item",DIR("?",2)="Enter a ""D"" if you wish to list all patients on a specific dispense drug,"
- S DIR("?")="or enter a ""V"" if you wish to list all patients on a VA class of drugs." D ^DIR K DIR S PSJSL=Y G:$D(DTOUT)!($D(DUOUT)) DONE
- ;
- DRGS S COUNT=1,BCNT=0 W !
- ;/IV Identifier is no longer used after POE
- ;/S PSJIDD=$P($G(^PS(59.7,1,31)),"^",2)
- F K DIC S DIC=$S(PSJSL="O":50.7,PSJSL="D":50,PSJSL="V":50.605),DIC(0)="QEAMZ" Q:$D(OUT) D
- .I PSJSL="O" D
- ..;/S DIC("W")="W "" ""_$P(^PS(50.606,$P(^PS(50.7,+Y,0),""^"",2),0),""^"")_$S($P(^PS(50.7,+Y,0),""^"",3):"" ""_$G(PSJIDD),1:"""")_"
- ..S DIC("W")="W "" ""_$P(^PS(50.606,$P(^PS(50.7,+Y,0),""^"",2),0),""^"")_"
- ..S DIC("W")=DIC("W")_""" ""_$S($P(^PS(50.7,+Y,0),""^"",4):$E($P(^(0),""^"",4),4,5)_""-""_$E($P(^(0),""^"",4),6,7)_""-""_$E($P(^(0),""^"",4),2,3),1:"""")"
- .D ^DIC K DIC S:$D(DTOUT)!($D(DUOUT)) QFLG=1 S:(+Y'>0) OUT=1 Q:+Y'>0 S IEN=+Y,NAME=$P(Y,U,2) D @PSJSL
- ;***PSJCNT is set to the number of drugs or classes the user chooses
- S PSJCNT=COUNT-1
- ;G:$D(QFLG)!(PSJCNT=0) DONE
- G:$D(QFLG)!(BCNT=0) DONE
- ;
- MATCH ;**prompt user for the number of matches
- W ! S DIR(0)="NAO^1:"_PSJCNT_":0",DIR("A")="Select number of matches: ",DIR("B")=PSJCNT
- S DIR("?",1)="Enter the number of drugs that a user must be receiving to appear",DIR("?",2)="on the report.",DIR("?",3)="",DIR("?")="The number must be between 1 and "_PSJCNT
- D ^DIR K DIR S PSJMAT=Y G:$D(DTOUT)!($D(DUOUT)) DONE
- ;
- ;
- DEV ; ask print device and queue if asked to
- K ZTSAVE S PSGTIR="ENQ^PSJPDV0",ZTDESC="List Patients on Specific Drugs" F X="CHOICE","PSJISP(","PSJSNM(","PSJREPS","PSJREPF","PSJSL","PSJSRT","PSJCNT","PSJMAT" S ZTSAVE(X)=""
- D ENDEV^PSGTI I POP!$D(ZTSK) W:POP !!?3,"No device selected for report run." W:$D(ZTSK) !?3,"Report Queued!" K ZTSK G DONE
- U IO
- W:$E(IOST)="C" !,"...this may take a few minutes...",!?25,"...you really should QUEUE this report, if possible..."
- D ^PSJPDV0
- I '$D(QFLG)&($E(IOST)="C") W !!,"Press RETURN to continue: " R CONT:DTIME
- ;
- DONE W:$E(IOST)="P" @IOF D ^%ZISC K %DT,CHOICE,CNT,CONT,COUNT,D,DIC,DTOUT,DUOUT,IEN,NAME,OUT,POP,PRIM,PSGP,PSGTIR,PSJCNT,PSJISP,PSJMAT,PSJREPF,PSJREPS,PSJSL,PSJSNM,PSJSRT,QFLG,SPDRG,X,Y
- ;/K GG,GGG,MATCHES,ON,OUT,PSIVUP,PSJACNWP,PSJIDD,PSJORIFN,PSJPAD,PSJPAGE,PSJPBID,PSJPCAF,PSJPDD,PSJDOB,PSJPDX,PSJPHT,PSJPHTD,PSJPPID,PSJPRB,PSJPSEX,PSJPSSN,PSJPTD,PSJPTS,PSJPTSD,PSJPWD,PSJPWDN,PSJPWT,PSJPWTD,PSJPDOB,PSJPTSP
- K GG,GGG,MATCHES,ON,OUT,PSIVUP,PSJACNWP,PSJORIFN,PSJPAD,PSJPAGE,PSJPBID,PSJPCAF,PSJPDD,PSJDOB,PSJPDX,PSJPHT,PSJPHTD,PSJPPID,PSJPRB,PSJPSEX,PSJPSSN,PSJPTD,PSJPTS,PSJPTSD,PSJPWD,PSJPWDN,PSJPWT,PSJPWTD,PSJPDOB,PSJPTSP
- Q
- ;
- P ;get primary drug from user
- W !!,"Dispense Drugs for ",NAME," are:"
- S SPDRG=0 F S SPDRG=$O(^PSDRUG("AP",IEN,SPDRG)) Q:'SPDRG W !,$P(^PSDRUG(SPDRG,0),"^") S PSJISP(SPDRG_"D")=COUNT_NAME,PSJSNM(NAME)=""
- I $D(PSJSNM(NAME)) S (COUNT,BCNT)=COUNT+1
- E W !," NONE FOUND"
- W ! Q
- ;
- O ;get orderable item from user
- ;/I $P($G(^PS(50.7,IEN,0)),"^",3) S PSJIDD=$P($G(^PS(59.7,1,31)),"^",2) D O1 Q
- NEW FIL F FIL=52.6,52.7 I $O(^PS(FIL,"AOI",IEN,0)) D O1 Q
- W !!,"Dispense Drugs for ",NAME," are:"
- S SPDRG=0 F S SPDRG=$O(^PSDRUG("ASP",IEN,SPDRG)) Q:'SPDRG W !,$P(^PSDRUG(SPDRG,0),"^") S PSJISP(SPDRG_"D")=COUNT_NAME,PSJSNM(NAME)=""
- I $D(PSJSNM(NAME)) S (COUNT,BCNT)=COUNT+1
- E W !," NONE FOUND"
- W ! Q
- O1 ; here if the orderable item is marked for IV use
- W !!,"Additives for ",NAME," are:"
- ;/S SPDRG=0 F S SPDRG=$O(^PS(52.6,"AOI",IEN,SPDRG)) Q:'SPDRG W !,$P(^PS(52.6,SPDRG,0),"^") S PSJISP(IEN_"O")=COUNT_NAME,PSJSNM(NAME_" "_PSJIDD)=""
- S SPDRG=0 F S SPDRG=$O(^PS(52.6,"AOI",IEN,SPDRG)) Q:'SPDRG W !,$P(^PS(52.6,SPDRG,0),"^") S PSJISP(IEN_"O")=COUNT_NAME,PSJSNM(NAME)=""
- ;/I $D(PSJSNM(NAME_" "_PSJIDD)) S (COUNT,BCNT)=COUNT+1
- I $D(PSJSNM(NAME)) S (COUNT,BCNT)=COUNT+1
- E W !," NONE FOUND" D
- .W !!,"Solutions for ",NAME," are:"
- .;/S SPDRG=0 F S SPDRG=$O(^PS(52.7,"AOI",IEN,SPDRG)) Q:'SPDRG W !,$P(^PS(52.7,SPDRG,0),"^") S PSJISP(IEN_"O")=COUNT_NAME,PSJSNM(NAME_" "_PSJIDD)=""
- .S SPDRG=0 F S SPDRG=$O(^PS(52.7,"AOI",IEN,SPDRG)) Q:'SPDRG W !,$P(^PS(52.7,SPDRG,0),"^") S PSJISP(IEN_"O")=COUNT_NAME,PSJSNM(NAME)=""
- .;/I $D(PSJSNM(NAME_" "_PSJIDD)) S (COUNT,BCNT)=COUNT+1
- .I $D(PSJSNM(NAME)) S (COUNT,BCNT)=COUNT+1
- .E W !," NONE FOUND"
- W ! Q
- ;
- D ;get dispense drug from user
- S PSJISP(IEN_"D")=COUNT,(BCNT,COUNT)=COUNT+1,PSJSNM(NAME)=""
- Q
- ;
- V ;get VA Class of Drug from user
- W !!,"Dispense Drugs for VA Class ",NAME," are: "
- S PRIM=0 F S PRIM=$O(^PSDRUG("AOC",PRIM)) Q:'PRIM S SPDRG=0 F S SPDRG=$O(^PSDRUG("AOC",PRIM,NAME,SPDRG)) Q:'SPDRG W !,$P(^PSDRUG(SPDRG,0),"^") S PSJISP(SPDRG_"D")=COUNT_NAME,PSJSNM(NAME)=""
- I $D(PSJSNM(NAME)) S (BCNT,COUNT)=COUNT+1
- W ! Q
- ;
- DT S Y=-1 F W !!,"Enter ",D," date: " R X:DTIME W:'$T $C(7) S:'$T X="^" D DTM:X?1."?",^%DT:"^"'[X I Y>0!("^"[X) W:Y<0 !,"No ",D," date chosen for notices run." Q
- Q
- DTM W !!,"Enter the ",D," date of the range of dates where you wish to see patients ",!,"on specific drugs. The start date and stop date may be the same." W:D="stop" " The stop",!,"date may not come before the start date." W ! Q
- PSJPDV ;BIR/KKA-LIST PATIENTS ON SPECIFIC DRUGS ;01 Mar 99 / 3:18 PM
- +1 ;;5.0; INPATIENT MEDICATIONS ;**9,22,30,50,67**;16 DEC 97
- +2 ;
- +3 ; Reference to ^PS(50.7 is supported by DBIA# 2180.
- +4 ; Reference to ^PS(52.6 is supported by DBIA# 1231.
- +5 ; Reference to ^PS(52.7 is supported by DBIA# 2173.
- +6 ; Reference to ^PS(59.7 is supported by DBIA# 2181.
- +7 ; Reference to ^PSDRUG is supported by DBIA# 2192.
- +8 ; Reference to ^PS(50.606 is supported by DBIA# 2174.
- +9 ; Reference to ^PS(50.605 is supported by DBIA# 696.
- +10 ; Reference to ^%DT is supported by DBIA# 10003.
- +11 ; Reference to ^%ZISC is supported by DBIA# 10089.
- +12 ; Reference to ^DIC is supported by DBIA# 10006.
- +13 ; Reference to ^DIR is supported by DBIA# 10024.
- +14 ;
- DATES ;prompt user for the range of dates
- +1 WRITE !
- SET %DT="ETX"
- SET D="start"
- DO DT
- IF Y'>0
- GOTO DONE
- SET (%DT(0),PSJREPS)=+Y
- SET D="stop"
- DO DT
- KILL %DT
- IF Y'>0
- GOTO DONE
- IF '$PIECE(PSJREPS,".",2)
- SET PSJREPS=PSJREPS+.0001
- SET PSJREPF=Y+$SELECT($PIECE(Y,".",2):0,1:.24)
- +2 ;
- ORDERS DO LIST^PSJEXP0
- IF $DATA(OUT)
- GOTO DONE
- WRITE !
- +1 ;
- SORT SET DIR(0)="SAOM^P:Patient;S:Start Date"
- SET DIR("A")="Do you wish to sort by (P)atient or (S)tart Date: "
- SET DIR("B")="Patient"
- +1 SET DIR("?",1)="Enter a ""P"" if you wish to sort by patient name or enter ""S"" if you"
- SET DIR("?")="wish to sort by order start date."
- DO ^DIR
- KILL DIR
- SET PSJSRT=Y
- IF $DATA(DTOUT)!($DATA(DUOUT))
- GOTO DONE
- +2 ;
- SELECT WRITE !
- SET DIR(0)="SAM^O:Orderable Item;D:Dispense Drug;V:VA Class of Drugs"
- SET DIR("A")="List by (O)rderable Item, (D)ispense Drug, or (V)A Class of Drugs: "
- +1 SET DIR("?",1)="Enter a ""O"" if you wish to list all patients on a specific orderable item"
- SET DIR("?",2)="Enter a ""D"" if you wish to list all patients on a specific dispense drug,"
- +2 SET DIR("?")="or enter a ""V"" if you wish to list all patients on a VA class of drugs."
- DO ^DIR
- KILL DIR
- SET PSJSL=Y
- IF $DATA(DTOUT)!($DATA(DUOUT))
- GOTO DONE
- +3 ;
- DRGS SET COUNT=1
- SET BCNT=0
- WRITE !
- +1 ;/IV Identifier is no longer used after POE
- +2 ;/S PSJIDD=$P($G(^PS(59.7,1,31)),"^",2)
- +3 FOR
- KILL DIC
- SET DIC=$SELECT(PSJSL="O":50.7,PSJSL="D":50,PSJSL="V":50.605)
- SET DIC(0)="QEAMZ"
- IF $DATA(OUT)
- QUIT
- Begin DoDot:1
- +4 IF PSJSL="O"
- Begin DoDot:2
- +5 ;/S DIC("W")="W "" ""_$P(^PS(50.606,$P(^PS(50.7,+Y,0),""^"",2),0),""^"")_$S($P(^PS(50.7,+Y,0),""^"",3):"" ""_$G(PSJIDD),1:"""")_"
- +6 SET DIC("W")="W "" ""_$P(^PS(50.606,$P(^PS(50.7,+Y,0),""^"",2),0),""^"")_"
- +7 SET DIC("W")=DIC("W")_""" ""_$S($P(^PS(50.7,+Y,0),""^"",4):$E($P(^(0),""^"",4),4,5)_""-""_$E($P(^(0),""^"",4),6,7)_""-""_$E($P(^(0),""^"",4),2,3),1:"""")"
- End DoDot:2
- +8 DO ^DIC
- KILL DIC
- IF $DATA(DTOUT)!($DATA(DUOUT))
- SET QFLG=1
- IF (+Y'>0)
- SET OUT=1
- IF +Y'>0
- QUIT
- SET IEN=+Y
- SET NAME=$PIECE(Y,U,2)
- DO @PSJSL
- End DoDot:1
- +9 ;***PSJCNT is set to the number of drugs or classes the user chooses
- +10 SET PSJCNT=COUNT-1
- +11 ;G:$D(QFLG)!(PSJCNT=0) DONE
- +12 IF $DATA(QFLG)!(BCNT=0)
- GOTO DONE
- +13 ;
- MATCH ;**prompt user for the number of matches
- +1 WRITE !
- SET DIR(0)="NAO^1:"_PSJCNT_":0"
- SET DIR("A")="Select number of matches: "
- SET DIR("B")=PSJCNT
- +2 SET DIR("?",1)="Enter the number of drugs that a user must be receiving to appear"
- SET DIR("?",2)="on the report."
- SET DIR("?",3)=""
- SET DIR("?")="The number must be between 1 and "_PSJCNT
- +3 DO ^DIR
- KILL DIR
- SET PSJMAT=Y
- IF $DATA(DTOUT)!($DATA(DUOUT))
- GOTO DONE
- +4 ;
- +5 ;
- DEV ; ask print device and queue if asked to
- +1 KILL ZTSAVE
- SET PSGTIR="ENQ^PSJPDV0"
- SET ZTDESC="List Patients on Specific Drugs"
- FOR X="CHOICE","PSJISP(","PSJSNM(","PSJREPS","PSJREPF","PSJSL","PSJSRT","PSJCNT","PSJMAT"
- SET ZTSAVE(X)=""
- +2 DO ENDEV^PSGTI
- IF POP!$DATA(ZTSK)
- IF POP
- WRITE !!?3,"No device selected for report run."
- IF $DATA(ZTSK)
- WRITE !?3,"Report Queued!"
- KILL ZTSK
- GOTO DONE
- +3 USE IO
- +4 IF $EXTRACT(IOST)="C"
- WRITE !,"...this may take a few minutes...",!?25,"...you really should QUEUE this report, if possible..."
- +5 DO ^PSJPDV0
- +6 IF '$DATA(QFLG)&($EXTRACT(IOST)="C")
- WRITE !!,"Press RETURN to continue: "
- READ CONT:DTIME
- +7 ;
- DONE IF $EXTRACT(IOST)="P"
- WRITE @IOF
- DO ^%ZISC
- KILL %DT,CHOICE,CNT,CONT,COUNT,D,DIC,DTOUT,DUOUT,IEN,NAME,OUT,POP,PRIM,PSGP,PSGTIR,PSJCNT,PSJISP,PSJMAT,PSJREPF,PSJREPS,PSJSL,PSJSNM,PSJSRT,QFLG,SPDRG,X,Y
- +1 ;/K GG,GGG,MATCHES,ON,OUT,PSIVUP,PSJACNWP,PSJIDD,PSJORIFN,PSJPAD,PSJPAGE,PSJPBID,PSJPCAF,PSJPDD,PSJDOB,PSJPDX,PSJPHT,PSJPHTD,PSJPPID,PSJPRB,PSJPSEX,PSJPSSN,PSJPTD,PSJPTS,PSJPTSD,PSJPWD,PSJPWDN,PSJPWT,PSJPWTD,PSJPDOB,PSJPTSP
- +2 KILL GG,GGG,MATCHES,ON,OUT,PSIVUP,PSJACNWP,PSJORIFN,PSJPAD,PSJPAGE,PSJPBID,PSJPCAF,PSJPDD,PSJDOB,PSJPDX,PSJPHT,PSJPHTD,PSJPPID,PSJPRB,PSJPSEX,PSJPSSN,PSJPTD,PSJPTS,PSJPTSD,PSJPWD,PSJPWDN,PSJPWT,PSJPWTD,PSJPDOB,PSJPTSP
- +3 QUIT
- +4 ;
- P ;get primary drug from user
- +1 WRITE !!,"Dispense Drugs for ",NAME," are:"
- +2 SET SPDRG=0
- FOR
- SET SPDRG=$ORDER(^PSDRUG("AP",IEN,SPDRG))
- IF 'SPDRG
- QUIT
- WRITE !,$PIECE(^PSDRUG(SPDRG,0),"^")
- SET PSJISP(SPDRG_"D")=COUNT_NAME
- SET PSJSNM(NAME)=""
- +3 IF $DATA(PSJSNM(NAME))
- SET (COUNT,BCNT)=COUNT+1
- +4 IF '$TEST
- WRITE !," NONE FOUND"
- +5 WRITE !
- QUIT
- +6 ;
- O ;get orderable item from user
- +1 ;/I $P($G(^PS(50.7,IEN,0)),"^",3) S PSJIDD=$P($G(^PS(59.7,1,31)),"^",2) D O1 Q
- +2 NEW FIL
- FOR FIL=52.6,52.7
- IF $ORDER(^PS(FIL,"AOI",IEN,0))
- DO O1
- QUIT
- +3 WRITE !!,"Dispense Drugs for ",NAME," are:"
- +4 SET SPDRG=0
- FOR
- SET SPDRG=$ORDER(^PSDRUG("ASP",IEN,SPDRG))
- IF 'SPDRG
- QUIT
- WRITE !,$PIECE(^PSDRUG(SPDRG,0),"^")
- SET PSJISP(SPDRG_"D")=COUNT_NAME
- SET PSJSNM(NAME)=""
- +5 IF $DATA(PSJSNM(NAME))
- SET (COUNT,BCNT)=COUNT+1
- +6 IF '$TEST
- WRITE !," NONE FOUND"
- +7 WRITE !
- QUIT
- O1 ; here if the orderable item is marked for IV use
- +1 WRITE !!,"Additives for ",NAME," are:"
- +2 ;/S SPDRG=0 F S SPDRG=$O(^PS(52.6,"AOI",IEN,SPDRG)) Q:'SPDRG W !,$P(^PS(52.6,SPDRG,0),"^") S PSJISP(IEN_"O")=COUNT_NAME,PSJSNM(NAME_" "_PSJIDD)=""
- +3 SET SPDRG=0
- FOR
- SET SPDRG=$ORDER(^PS(52.6,"AOI",IEN,SPDRG))
- IF 'SPDRG
- QUIT
- WRITE !,$PIECE(^PS(52.6,SPDRG,0),"^")
- SET PSJISP(IEN_"O")=COUNT_NAME
- SET PSJSNM(NAME)=""
- +4 ;/I $D(PSJSNM(NAME_" "_PSJIDD)) S (COUNT,BCNT)=COUNT+1
- +5 IF $DATA(PSJSNM(NAME))
- SET (COUNT,BCNT)=COUNT+1
- +6 IF '$TEST
- WRITE !," NONE FOUND"
- Begin DoDot:1
- +7 WRITE !!,"Solutions for ",NAME," are:"
- +8 ;/S SPDRG=0 F S SPDRG=$O(^PS(52.7,"AOI",IEN,SPDRG)) Q:'SPDRG W !,$P(^PS(52.7,SPDRG,0),"^") S PSJISP(IEN_"O")=COUNT_NAME,PSJSNM(NAME_" "_PSJIDD)=""
- +9 SET SPDRG=0
- FOR
- SET SPDRG=$ORDER(^PS(52.7,"AOI",IEN,SPDRG))
- IF 'SPDRG
- QUIT
- WRITE !,$PIECE(^PS(52.7,SPDRG,0),"^")
- SET PSJISP(IEN_"O")=COUNT_NAME
- SET PSJSNM(NAME)=""
- +10 ;/I $D(PSJSNM(NAME_" "_PSJIDD)) S (COUNT,BCNT)=COUNT+1
- +11 IF $DATA(PSJSNM(NAME))
- SET (COUNT,BCNT)=COUNT+1
- +12 IF '$TEST
- WRITE !," NONE FOUND"
- End DoDot:1
- +13 WRITE !
- QUIT
- +14 ;
- D ;get dispense drug from user
- +1 SET PSJISP(IEN_"D")=COUNT
- SET (BCNT,COUNT)=COUNT+1
- SET PSJSNM(NAME)=""
- +2 QUIT
- +3 ;
- V ;get VA Class of Drug from user
- +1 WRITE !!,"Dispense Drugs for VA Class ",NAME," are: "
- +2 SET PRIM=0
- FOR
- SET PRIM=$ORDER(^PSDRUG("AOC",PRIM))
- IF 'PRIM
- QUIT
- SET SPDRG=0
- FOR
- SET SPDRG=$ORDER(^PSDRUG("AOC",PRIM,NAME,SPDRG))
- IF 'SPDRG
- QUIT
- WRITE !,$PIECE(^PSDRUG(SPDRG,0),"^")
- SET PSJISP(SPDRG_"D")=COUNT_NAME
- SET PSJSNM(NAME)=""
- +3 IF $DATA(PSJSNM(NAME))
- SET (BCNT,COUNT)=COUNT+1
- +4 WRITE !
- QUIT
- +5 ;
- DT SET Y=-1
- FOR
- WRITE !!,"Enter ",D," date: "
- READ X:DTIME
- IF '$TEST
- WRITE $CHAR(7)
- IF '$TEST
- SET X="^"
- IF X?1."?"
- DO DTM
- IF "^"'[X
- DO ^%DT
- IF Y>0!("^"[X)
- IF Y<0
- WRITE !,"No ",D," date chosen for notices run."
- QUIT
- +1 QUIT
- DTM WRITE !!,"Enter the ",D," date of the range of dates where you wish to see patients ",!,"on specific drugs. The start date and stop date may be the same."
- IF D="stop"
- WRITE " The stop",!,"date may not come before the start date."
- WRITE !
- QUIT
