- PSAOP ;BIR/LTL-Outpatient Dispensing (Single Drug) ;7/23/97
- ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**3,15**; 10/24/97
- ;This routine is the gathers OP dispensing for a date range.
- ;
- ;References to ^PSDRUG( are covered by IA #2095
- ;References to ^PSRX( are covered by IA #254
- ;
- D PSAWARN^PSAPSI I $D(PSAQUIT) K PSAQUIT Q
- ;
- N DIC,DIE,DINUM,D0,D1,DLAYGO,DR,DIR,DIRUT,DTOUT,DUOUT,PSADR,PSADREC,PSADT,PSAPG,PSAS,PSA,PSAOUT,PSARELDT,PSADT,DA,PSADRUG,PSADRUGN,PSALN,PSAP,PSAN,PSAQ,PSAR,X,X2,Y
- LOOK D:'$G(PSALOC) OP^PSADA
- I $G(PSALOC)<0 K PSALOC G QUIT
- S:'$G(PSALOCN) PSALOCN=$P($G(^PSD(58.8,+PSALOC,0)),U)
- S DIR(0)="Y",DIR("A")="OK",DIR("B")="Yes",DIR("?")="No allows you to change Location." D ^DIR K DIR S:$D(DIRUT) PSAOUT=1 G:$D(DIRUT) QUIT I Y=0 K PSALOC D OP^PSADA G:'$G(PSALOC) QUIT
- I '$O(^PSD(58.8,+PSALOC,1,0)) W !!,"There are no drugs in ",PSALOCN G QUIT
- D NOW^%DTC S PSADT=X,X="T-6000" D ^%DT S PSADT(1)=Y
- S DIC="^PSD(58.8,+PSALOC,1,",DIC(0)="AEQ",DIC("A")="Please select "_PSALOCN_"'S drug: ",DIC("S")="I $S($P($G(^(0)),U,14):$P($G(^(0)),U,14)>DT,1:1)"
- S PSAS=$P($G(^PSD(58.8,+PSALOC,0)),U,10),PSADT(3)=0
- F W ! S DA(1)=PSALOC D ^DIC G:Y<0 QUIT S PSADRUG=+Y D G:$G(PSAOUT) QUIT G:$G(PSA(5)) TR D DEV Q:$G(PSAOUT)
- .D:'$G(^PSD(58.8,+PSALOC,1,+PSADRUG,6)) Q:$G(PSAOUT)
- ..W !!,"Dispensing has never been collected for this drug.",!!
- ..S DIR(0)="D^"_PSADT(1)_":"_PSADT_":AEX",DIR("A")="How far back would you like to collect",DIR("B")="T-6000" D ^DIR K DIR S (PSADT(2),PSADT(4),PSAR,PSAP,PSAN)=Y,(PSADT(3),PSAR(1),PSAP(1),PSAN(1))=0 I Y<1 S PSAOUT=1 Q
- .S PSAG=$G(^PSD(58.8,+PSALOC,1,+PSADRUG,6))
- .S:'$G(PSADT(2)) PSADT(2)=$P(PSAG,U),PSA(7)=1
- .W !!,"Checking dispensing"
- .S:'$G(PSAR) PSAR=$P(PSAG,U,2) S:'$G(PSAP) PSAP=$P(PSAG,U,7)
- .S:'$G(PSAN) PSAN=$P(PSAG,U,9) S (PSAR(1),PSAP(1),PSAN(1))=0
- .F S PSADT(2)=$O(^PSRX("AL",PSADT(2))) Q:'PSADT(2) F S PSADT(3)=$O(^PSRX("AL",+PSADT(2),PSADT(3))) Q:'PSADT(3) W:'(PSADT(3)#10) "." D:$P($G(^PSRX(+PSADT(3),0)),U,6)=PSADRUG&($P($G(^PSRX(+PSADT(3),2)),U,9)=PSAS)
- ..S PSADT(4)="" F S PSADT(4)=$O(^PSRX("AL",+PSADT(2),+PSADT(3),PSADT(4))) Q:PSADT(4)="" D
- ...;
- ...;DAVE B (PSA*3*3)
- ...Q:$D(^PSRX("AR",+PSADT(2),+PSADT(3),PSADT(4))) ;Released to CMOP, do not count
- ...S ^TMP("PSA",$J,+PSADRUG,$E(PSADT(2),1,7))=($P($G(^TMP("PSA",$J,+PSADRUG,$E(PSADT(2),1,7))),U)+$S(PSADT(4):$P($G(^PSRX(+PSADT(3),1,+PSADT(4),0)),U,4),1:$P($G(^PSRX(+PSADT(3),0)),U,7)))_U_PSADT(2)_U_PSADT(3),PSA(9)=PSADT(3)
- .W !!,"Checking refills"
- .D:$O(^PSRX("AJ",PSAR))
- ..F S PSAR=$O(^PSRX("AJ",PSAR)) Q:'PSAR F S PSAR(1)=$O(^PSRX("AJ",+PSAR,+PSAR(1))) Q:'PSAR(1) W "." D:$P($G(^PSRX(+PSAR(1),0)),U,6)=PSADRUG&($P($G(^PSRX(+PSAR(1),2)),U,9)=PSAS)
- ...S PSAR(3)="" F S PSAR(3)=$O(^PSRX("AJ",+PSAR,+PSAR(1),PSAR(3))) Q:PSAR(3)="" D
- ....S $P(^TMP("PSA",$J,+PSADRUG,$E(PSAR,1,7)),U)=($P($G(^TMP("PSA",$J,+PSADRUG,$E(PSAR,1,7))),U)-$S(PSAR(3):$P($G(^PSRX(+PSAR(1),1,+PSAR(3),0)),U,4),1:$P($G(^PSRX(+PSAR(1),0)),U,7)))
- ....S $P(^TMP("PSA",$J,+PSADRUG,$E(PSAR,1,7)),U,4)=PSAR,$P(^($E(PSAR,1,7)),U,5)=PSAR(1),PSAR(2)=PSAR(1)
- .D:$O(^PSRX("AM",+PSAP))!($O(^PSRX("AN",+PSAN))) AM^PSAOP4
- .I '$D(^TMP("PSA",$J,+PSADRUG)) W !!,"Sorry, no dispensing for this drug has occurred since " S Y=$S($P(PSAG,U):$P(PSAG,U),1:$G(PSADT(4))) X ^DD("DD") W Y,".",! S PSAOUT=1 Q
- .S DIR(0)="Y",DIR("A")="Would you like a report of dispensing totals",DIR("B")="Yes" D ^DIR K DIR S:$D(DIRUT) PSAOUT=1 S:Y'=1 PSA(5)=1
- ;
- DEV K IO("Q") N %ZIS,IOP,POP S %ZIS="Q" I Y=1 W ! D ^%ZIS
- I $G(POP) W !,"NO DEVICE SELECTED OR ACTION TAKEN!" S PSAOUT=1 G QUIT
- I $D(IO("Q")) N ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTDTH,ZTSK S ZTRTN="LUP^PSAOP",ZTDESC="Drug Acct-OP Dispensing Log",(ZTSAVE("^TMP(""PSA"",$J,+PSADRUG,"),ZTSAVE("PSA*"))="" D ^%ZTLOAD,HOME^%ZIS G QUIT
- LUP S (PSAPG,PSAOUT)=0,PSADRUG(1)=$P($G(^PSDRUG(+PSADRUG,660)),U,6),PSADRUG(2)=$P($G(^(660)),U,8)
- S X=PSADRUG(1),X2="3$" D COMMA^%DTC S PSADRUG(3)=X
- D HEADER
- S (PSA(4),PSA(6))=0 F S PSA(4)=$O(^TMP("PSA",$J,+PSADRUG,PSA(4))) Q:'PSA(4) S PSA(6)=PSA(6)+1,Y=PSA(4) X ^DD("DD") D
- .W !!,Y S X=$P($G(^TMP("PSA",$J,+PSADRUG,PSA(4))),U),X2=0 D COMMA^%DTC W ?14,X,PSADRUG(2),?40,PSADRUG(3),"/",PSADRUG(2),?63
- .S PSADRUG(4)=$G(PSADRUG(4))+$P($G(^TMP("PSA",$J,+PSADRUG,PSA(4))),U)
- .S X=$P($G(^TMP("PSA",$J,+PSADRUG,PSA(4))),U)*PSADRUG(1),PSADRUG(5)=$G(PSADRUG(5))+X,X2="2$" D COMMA^%DTC W ?40,X
- W !,PSALN,!,PSA(6)," DAY TOTALS: " S X=PSADRUG(4),X2=0 D COMMA^%DTC W ?5,X,PSADRUG(2)
- S X=PSADRUG(5),X2="2$" D COMMA^%DTC W ?63,X
- STOP W:$E(IOST)'="C" @IOF
- I $E(IOST,1,2)="C-",'$G(PSAOUT) W ! S DIR(0)="EA",DIR("A")="END OF REPORT! Press <RET> to return to the menu." D ^DIR K DIR
- D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@" K IO("Q")
- W !!,"Updating history and dispensing totals."
- TR S ZTIO="",ZTRTN="LOOP^PSAOP",ZTDESC="Drug Acct-Dispensing Totals",ZTDTH=$H,(ZTSAVE("^TMP(""PSA"",$J,+PSADRUG,"),ZTSAVE("PSA*"))="" D ^%ZTLOAD,HOME^%ZIS
- K ^TMP("PSA",$J,+PSADRUG),PSA,PSADRUG
- QUIT Q
- I $$S^%ZTLOAD S PSAOUT=1 Q
- W:$Y @IOF S $P(PSALN,"-",81)="",PSAPG=PSAPG+1 W !,?2,"DAILY DISPENSING TOTALS FOR ",$E($P($G(^PSDRUG(+PSADRUG,0)),U),1,30),?70,"PAGE: ",PSAPG,!,PSALN,!
- W " DATE",?23,"TOTAL",?45,"$/DISP",?67,"TOTAL",!
- W "DISPENSED",?23,"DISP",?46,"UNIT",?68,"COST",!,PSALN
- Q
- LOOP S PSA(2)=0 F S PSA(2)=$O(^TMP("PSA",$J,+PSADRUG,PSA(2))) Q:'PSA(2) S PSA(3)=$P(^TMP("PSA",$J,+PSADRUG,PSA(2)),"^") D
- .;PSA*3*25 Dave B - Remove single reference for OP site
- .S PSA=^TMP("PSA",$J,+PSADRUG,PSA(2)),PSAOP=+$P($G(^PSD(58.8,PSALOC,0)),"^",10),PSARELDT=+$P(PSA(2),".")
- .K:$D(^XTMP("PSA",PSAOP,PSADRUG,PSARELDT)) ^XTMP("PSA",PSAOP,PSADRUG,PSARELDT)
- .D ^PSAOP1
- .S DIE="^PSD(58.8,"_+PSALOC_",1,",DA(1)=PSALOC,DA=PSADRUG
- .S DR="22////"_$P(PSA,U,2)_";22.1////"_$P(PSA,U,3)_";23////"_$P(PSA,U,4)_";23.1////"_$P(PSA,U,5)_";22.2////"_$P(PSA,U,6)_";22.3////"_$P(PSA,U,7)_";23.2////"_$P(PSA,U,8)_";23.3////"_$P(PSA,U,9)
- .D ^DIE K DA,DIE,DR
- Q
- PSAOP ;BIR/LTL-Outpatient Dispensing (Single Drug) ;7/23/97
- +1 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**3,15**; 10/24/97
- +2 ;This routine is the gathers OP dispensing for a date range.
- +3 ;
- +4 ;References to ^PSDRUG( are covered by IA #2095
- +5 ;References to ^PSRX( are covered by IA #254
- +6 ;
- +7 DO PSAWARN^PSAPSI
- IF $DATA(PSAQUIT)
- KILL PSAQUIT
- QUIT
- +8 ;
- +9 NEW DIC,DIE,DINUM,D0,D1,DLAYGO,DR,DIR,DIRUT,DTOUT,DUOUT,PSADR,PSADREC,PSADT,PSAPG,PSAS,PSA,PSAOUT,PSARELDT,PSADT,DA,PSADRUG,PSADRUGN,PSALN,PSAP,PSAN,PSAQ,PSAR,X,X2,Y
- LOOK IF '$GET(PSALOC)
- DO OP^PSADA
- +1 IF $GET(PSALOC)<0
- KILL PSALOC
- GOTO QUIT
- +2 IF '$GET(PSALOCN)
- SET PSALOCN=$PIECE($GET(^PSD(58.8,+PSALOC,0)),U)
- +3 SET DIR(0)="Y"
- SET DIR("A")="OK"
- SET DIR("B")="Yes"
- SET DIR("?")="No allows you to change Location."
- DO ^DIR
- KILL DIR
- IF $DATA(DIRUT)
- SET PSAOUT=1
- IF $DATA(DIRUT)
- GOTO QUIT
- IF Y=0
- KILL PSALOC
- DO OP^PSADA
- IF '$GET(PSALOC)
- GOTO QUIT
- +4 IF '$ORDER(^PSD(58.8,+PSALOC,1,0))
- WRITE !!,"There are no drugs in ",PSALOCN
- GOTO QUIT
- +5 DO NOW^%DTC
- SET PSADT=X
- SET X="T-6000"
- DO ^%DT
- SET PSADT(1)=Y
- +6 SET DIC="^PSD(58.8,+PSALOC,1,"
- SET DIC(0)="AEQ"
- SET DIC("A")="Please select "_PSALOCN_"'S drug: "
- SET DIC("S")="I $S($P($G(^(0)),U,14):$P($G(^(0)),U,14)>DT,1:1)"
- +7 SET PSAS=$PIECE($GET(^PSD(58.8,+PSALOC,0)),U,10)
- SET PSADT(3)=0
- +8 FOR
- WRITE !
- SET DA(1)=PSALOC
- DO ^DIC
- IF Y<0
- GOTO QUIT
- SET PSADRUG=+Y
- Begin DoDot:1
- +9 IF '$GET(^PSD(58.8,+PSALOC,1,+PSADRUG,6))
- Begin DoDot:2
- +10 WRITE !!,"Dispensing has never been collected for this drug.",!!
- +11 SET DIR(0)="D^"_PSADT(1)_":"_PSADT_":AEX"
- SET DIR("A")="How far back would you like to collect"
- SET DIR("B")="T-6000"
- DO ^DIR
- KILL DIR
- SET (PSADT(2),PSADT(4),PSAR,PSAP,PSAN)=Y
- SET (PSADT(3),PSAR(1),PSAP(1),PSAN(1))=0
- IF Y<1
- SET PSAOUT=1
- QUIT
- End DoDot:2
- IF $GET(PSAOUT)
- QUIT
- +12 SET PSAG=$GET(^PSD(58.8,+PSALOC,1,+PSADRUG,6))
- +13 IF '$GET(PSADT(2))
- SET PSADT(2)=$PIECE(PSAG,U)
- SET PSA(7)=1
- +14 WRITE !!,"Checking dispensing"
- +15 IF '$GET(PSAR)
- SET PSAR=$PIECE(PSAG,U,2)
- IF '$GET(PSAP)
- SET PSAP=$PIECE(PSAG,U,7)
- +16 IF '$GET(PSAN)
- SET PSAN=$PIECE(PSAG,U,9)
- SET (PSAR(1),PSAP(1),PSAN(1))=0
- +17 FOR
- SET PSADT(2)=$ORDER(^PSRX("AL",PSADT(2)))
- IF 'PSADT(2)
- QUIT
- FOR
- SET PSADT(3)=$ORDER(^PSRX("AL",+PSADT(2),PSADT(3)))
- IF 'PSADT(3)
- QUIT
- IF '(PSADT(3)#10)
- WRITE "."
- IF $PIECE($GET(^PSRX(+PSADT(3),0)),U,6)=PSADRUG&($PIECE($GET(^PSRX(+PSADT(3),2)),U,9)=PSAS)
- Begin DoDot:2
- +18 SET PSADT(4)=""
- FOR
- SET PSADT(4)=$ORDER(^PSRX("AL",+PSADT(2),+PSADT(3),PSADT(4)))
- IF PSADT(4)=""
- QUIT
- Begin DoDot:3
- +19 ;
- +20 ;DAVE B (PSA*3*3)
- +21 ;Released to CMOP, do not count
- IF $DATA(^PSRX("AR",+PSADT(2),+PSADT(3),PSADT(4)))
- QUIT
- +22 SET ^TMP("PSA",$JOB,+PSADRUG,$EXTRACT(PSADT(2),1,7))=($PIECE($GET(^TMP("PSA",$JOB,+PSADRUG,$EXTRACT(PSADT(2),1,7))),U)+$SELECT(PSADT(4):$PIECE($GET(^PSRX(+PSADT(3),1,+PSADT(4),0)),U,4),1:$PIECE($GET(^PSRX(+PSADT(
- 3),0)),U,7)))_U_PSADT(2)_U_PSADT(3)
- SET PSA(9)=PSADT(3)
- End DoDot:3
- End DoDot:2
- +23 WRITE !!,"Checking refills"
- +24 IF $ORDER(^PSRX("AJ",PSAR))
- Begin DoDot:2
- +25 FOR
- SET PSAR=$ORDER(^PSRX("AJ",PSAR))
- IF 'PSAR
- QUIT
- FOR
- SET PSAR(1)=$ORDER(^PSRX("AJ",+PSAR,+PSAR(1)))
- IF 'PSAR(1)
- QUIT
- WRITE "."
- IF $PIECE($GET(^PSRX(+PSAR(1),0)),U,6)=PSADRUG&($PIECE($GET(^PSRX(+PSAR(1),2)),U,9)=PSAS)
- Begin DoDot:3
- +26 SET PSAR(3)=""
- FOR
- SET PSAR(3)=$ORDER(^PSRX("AJ",+PSAR,+PSAR(1),PSAR(3)))
- IF PSAR(3)=""
- QUIT
- Begin DoDot:4
- +27 SET $PIECE(^TMP("PSA",$JOB,+PSADRUG,$EXTRACT(PSAR,1,7)),U)=($PIECE($GET(^TMP("PSA",$JOB,+PSADRUG,$EXTRACT(PSAR,1,7))),U)-$SELECT(PSAR(3):$PIECE($GET(^PSRX(+PSAR(1),1,+PSAR(3),0)),U,4),1:$PIECE($GET(^PSRX(
- +PSAR(1),0)),U,7)))
- +28 SET $PIECE(^TMP("PSA",$JOB,+PSADRUG,$EXTRACT(PSAR,1,7)),U,4)=PSAR
- SET $PIECE(^($EXTRACT(PSAR,1,7)),U,5)=PSAR(1)
- SET PSAR(2)=PSAR(1)
- End DoDot:4
- End DoDot:3
- End DoDot:2
- +29 IF $ORDER(^PSRX("AM",+PSAP))!($ORDER(^PSRX("AN",+PSAN)))
- DO AM^PSAOP4
- +30 IF '$DATA(^TMP("PSA",$JOB,+PSADRUG))
- WRITE !!,"Sorry, no dispensing for this drug has occurred since "
- SET Y=$SELECT($PIECE(PSAG,U):$PIECE(PSAG,U),1:$GET(PSADT(4)))
- XECUTE ^DD("DD")
- WRITE Y,".",!
- SET PSAOUT=1
- QUIT
- +31 SET DIR(0)="Y"
- SET DIR("A")="Would you like a report of dispensing totals"
- SET DIR("B")="Yes"
- DO ^DIR
- KILL DIR
- IF $DATA(DIRUT)
- SET PSAOUT=1
- IF Y'=1
- SET PSA(5)=1
- End DoDot:1
- IF $GET(PSAOUT)
- GOTO QUIT
- IF $GET(PSA(5))
- GOTO TR
- DO DEV
- IF $GET(PSAOUT)
- QUIT
- +32 ;
- DEV KILL IO("Q")
- NEW %ZIS,IOP,POP
- SET %ZIS="Q"
- IF Y=1
- WRITE !
- DO ^%ZIS
- +1 IF $GET(POP)
- WRITE !,"NO DEVICE SELECTED OR ACTION TAKEN!"
- SET PSAOUT=1
- GOTO QUIT
- +2 IF $DATA(IO("Q"))
- NEW ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTDTH,ZTSK
- SET ZTRTN="LUP^PSAOP"
- SET ZTDESC="Drug Acct-OP Dispensing Log"
- SET (ZTSAVE("^TMP(""PSA"",$J,+PSADRUG,"),ZTSAVE("PSA*"))=""
- DO ^%ZTLOAD
- DO HOME^%ZIS
- GOTO QUIT
- LUP SET (PSAPG,PSAOUT)=0
- SET PSADRUG(1)=$PIECE($GET(^PSDRUG(+PSADRUG,660)),U,6)
- SET PSADRUG(2)=$PIECE($GET(^(660)),U,8)
- +1 SET X=PSADRUG(1)
- SET X2="3$"
- DO COMMA^%DTC
- SET PSADRUG(3)=X
- +2 DO HEADER
- +3 SET (PSA(4),PSA(6))=0
- FOR
- SET PSA(4)=$ORDER(^TMP("PSA",$JOB,+PSADRUG,PSA(4)))
- IF 'PSA(4)
- QUIT
- SET PSA(6)=PSA(6)+1
- SET Y=PSA(4)
- XECUTE ^DD("DD")
- Begin DoDot:1
- +4 WRITE !!,Y
- SET X=$PIECE($GET(^TMP("PSA",$JOB,+PSADRUG,PSA(4))),U)
- SET X2=0
- DO COMMA^%DTC
- WRITE ?14,X,PSADRUG(2),?40,PSADRUG(3),"/",PSADRUG(2),?63
- +5 SET PSADRUG(4)=$GET(PSADRUG(4))+$PIECE($GET(^TMP("PSA",$JOB,+PSADRUG,PSA(4))),U)
- +6 SET X=$PIECE($GET(^TMP("PSA",$JOB,+PSADRUG,PSA(4))),U)*PSADRUG(1)
- SET PSADRUG(5)=$GET(PSADRUG(5))+X
- SET X2="2$"
- DO COMMA^%DTC
- WRITE ?40,X
- End DoDot:1
- +7 WRITE !,PSALN,!,PSA(6)," DAY TOTALS: "
- SET X=PSADRUG(4)
- SET X2=0
- DO COMMA^%DTC
- WRITE ?5,X,PSADRUG(2)
- +8 SET X=PSADRUG(5)
- SET X2="2$"
- DO COMMA^%DTC
- WRITE ?63,X
- STOP IF $EXTRACT(IOST)'="C"
- WRITE @IOF
- +1 IF $EXTRACT(IOST,1,2)="C-"
- IF '$GET(PSAOUT)
- WRITE !
- SET DIR(0)="EA"
- SET DIR("A")="END OF REPORT! Press <RET> to return to the menu."
- DO ^DIR
- KILL DIR
- +2 DO ^%ZISC
- IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- KILL IO("Q")
- +3 WRITE !!,"Updating history and dispensing totals."
- TR SET ZTIO=""
- SET ZTRTN="LOOP^PSAOP"
- SET ZTDESC="Drug Acct-Dispensing Totals"
- SET ZTDTH=$HOROLOG
- SET (ZTSAVE("^TMP(""PSA"",$J,+PSADRUG,"),ZTSAVE("PSA*"))=""
- DO ^%ZTLOAD
- DO HOME^%ZIS
- +1 KILL ^TMP("PSA",$JOB,+PSADRUG),PSA,PSADRUG
- QUIT QUIT
- IF PSAPG
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- IF 'Y
- SET PSAOUT=1
- QUIT
- +1 IF $$S^%ZTLOAD
- SET PSAOUT=1
- QUIT
- +2 IF $Y
- WRITE @IOF
- SET $PIECE(PSALN,"-",81)=""
- SET PSAPG=PSAPG+1
- WRITE !,?2,"DAILY DISPENSING TOTALS FOR ",$EXTRACT($PIECE($GET(^PSDRUG(+PSADRUG,0)),U),1,30),?70,"PAGE: ",PSAPG,!,PSALN,!
- +3 WRITE " DATE",?23,"TOTAL",?45,"$/DISP",?67,"TOTAL",!
- +4 WRITE "DISPENSED",?23,"DISP",?46,"UNIT",?68,"COST",!,PSALN
- +5 QUIT
- LOOP SET PSA(2)=0
- FOR
- SET PSA(2)=$ORDER(^TMP("PSA",$JOB,+PSADRUG,PSA(2)))
- IF 'PSA(2)
- QUIT
- SET PSA(3)=$PIECE(^TMP("PSA",$JOB,+PSADRUG,PSA(2)),"^")
- Begin DoDot:1
- +1 ;PSA*3*25 Dave B - Remove single reference for OP site
- +2 SET PSA=^TMP("PSA",$JOB,+PSADRUG,PSA(2))
- SET PSAOP=+$PIECE($GET(^PSD(58.8,PSALOC,0)),"^",10)
- SET PSARELDT=+$PIECE(PSA(2),".")
- +3 IF $DATA(^XTMP("PSA",PSAOP,PSADRUG,PSARELDT))
- KILL ^XTMP("PSA",PSAOP,PSADRUG,PSARELDT)
- +4 DO ^PSAOP1
- +5 SET DIE="^PSD(58.8,"_+PSALOC_",1,"
- SET DA(1)=PSALOC
- SET DA=PSADRUG
- +6 SET DR="22////"_$PIECE(PSA,U,2)_";22.1////"_$PIECE(PSA,U,3)_";23////"_$PIECE(PSA,U,4)_";23.1////"_$PIECE(PSA,U,5)_";22.2////"_$PIECE(PSA,U,6)_";22.3////"_$PIECE(PSA,U,7)_";23.2////"_$PIECE(PSA,U,8)_";23.3////"_$PIECE(PSA,U,9)
- +7 DO ^DIE
- KILL DA,DIE,DR
- End DoDot:1
- +8 QUIT
