PSDRF1.m

PSDRF1 ;B'ham ISC/JPW,LTL - File Dispensing Info ; 13 Dec 93

 ;;3.0; CONTROLLED SUBSTANCES ;**66**;13 Feb 97;Build 3

UPDAT I $G(PSDPN) F JJ=0:0 S JJ=$O(^PSD(58.8,"F",PSDPN,NAOU,PSDR,JJ)) Q:'JJ  S ORD=+JJ

 ;$S(WQTY:18,CQTY:9,1:17) S:PSDTYP=9 QTY=CQTY-OQTY

 W ?40,"Recording transaction...  "

 D UPDATE W "done."

END ;kill variables

 K %,%DT,%H,%I,BAL,CQTY,DA,DIC,DIE,DIK,DINUM,DLAYGO,DR,JJ,LQTY,NAOUN,NODE,NUR2,OK,ORD

 K PSD,PSDER,PSDREC,PSDRN,PSDT,PSDTN,QTY,WQTY,X,Y

 Q

UPDATE ;update 58.8 and 58.81

 ;updating drug balance in 58.8

 F  L +^PSD(58.8,NAOU,1,PSDR,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I  Q

 D NOW^%DTC S (PSDTN,PSDT)=+%

 S BAL=$P(^PSD(58.8,NAOU,1,PSDR,0),"^",4),$P(^(0),"^",4)=$P(^(0),"^",4)-PSDQ

 L -^PSD(58.8,NAOU,1,PSDR,0)

 ;update order balance

 ;I $G(ORD),$D(^PSD(58.8,NAOU,1,PSDR,3,ORD,0)),PSDTYP'=9 S $P(^(0),"^",22)=$P(^(0),"^",22)-PSDQ,DA=+$P(^(0),"^",17) D:$P(^(0),"^",22)=0  K DA,DIE,DR

 ;.K DIE,DR S DIE="^PSD(58.81,",DR="10////12;11////1" D ^DIE K DA,DIE,DR

 ;.K DA,DIE,DR S DIE="^PSD(58.8,"_NAOU_",1,"_PSDR_",3,",DA=+ORD,DA(1)=+PSDR,DA(2)=+NAOU,DR="10////12;11////1" D ^DIE K DA,DIE,DR

ADD ;find entry number in 58.81

 F  L +^PSD(58.81,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I  Q

FIND S PSDREC=$P(^PSD(58.81,0),"^",3)+1 I $D(^PSD(58.81,PSDREC)) S $P(^PSD(58.81,0),"^",3)=PSDREC G FIND

 K DIC,DLAYGO S DIC(0)="L",(DIC,DLAYGO)=58.81,(X,DINUM)=PSDREC D ^DIC K DIC,DLAYGO

 L -^PSD(58.81,0)

EDIT ;edit new transaction in 58.81

 S ^PSD(58.81,PSDREC,0)=PSDREC_"^"_PSDTYP_"^"_NAOU_"^"_PSDT_"^"_PSDR_"^"_$S(PSDTYP=9:-PSDQ,1:PSDQ)_"^"_$G(NUR1)_"^^^"_BAL_"^^^^^^"_$S(PSDTYP=9:$G(PSDRE),1:"")_"^"_$G(PSDPN)_"^"_NAOU_"^^"_$G(ORD)

 S ^PSD(58.81,PSDREC,9)=$G(PAT)_"^"_NUR1_"^"_OQTY_"^"_$G(WQTY)_"^"_$G(LQTY)_"^"_$G(NUR2)_"^"_BAL

 ;S:PATL ^PSD(58.81,PSDREC,9.5)=PATL

 S ^PSD(58.81,PSDREC,"CS")=1

 K DA,DIK S DA=PSDREC,DIK="^PSD(58.81," D IX^DIK K DA,DIK

 I PSDTYP'=17 D ERR

 Q

ERR ;err log update

 F  L +^PSD(58.89,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I  Q

FIND9 S PSDER=$P(^PSD(58.89,0),"^",3)+1 I $D(^PSD(58.89,PSDER)) S $P(^PSD(58.89,0),"^",3)=PSDER G FIND9

 K DIC,DLAYGO S DIC(0)="L",(DIC,DLAYGO)=58.89,(X,DINUM)=PSDER D ^DIC K DIC,DLAYGO

 L -^PSD(58.89,0)

EDIT9 ;edit error log

 K DA,DIE,DR S DA=PSDER,DIE=58.89,DR="1////"_PSDREC_";2////"_PSDT_";6////"_NAOU D ^DIE K DA,DIE,DR

 S PHARM1=NUR1,QTY=PSDQ

 S:$G(NAOUN)']"" NAOUN=$P($G(^PSD(58.8,NAOU,0)),U) D ^PSDRFM

 Q

PSDRF1    ;B'ham ISC/JPW,LTL - File Dispensing Info ; 13 Dec 93

 +1       ;;3.0; CONTROLLED SUBSTANCES ;**66**;13 Feb 97;Build 3

UPDAT      IF $GET(PSDPN)

               FOR JJ=0:0

                   SET JJ=$ORDER(^PSD(58.8,"F",PSDPN,NAOU,PSDR,JJ))

                   IF 'JJ

                       QUIT 

                   SET ORD=+JJ

 +1       ;$S(WQTY:18,CQTY:9,1:17) S:PSDTYP=9 QTY=CQTY-OQTY

 +2        WRITE ?40,"Recording transaction...  "

 +3        DO UPDATE

           WRITE "done."

END       ;kill variables

 +1        KILL %,%DT,%H,%I,BAL,CQTY,DA,DIC,DIE,DIK,DINUM,DLAYGO,DR,JJ,LQTY,NAOUN,NODE,NUR2,OK,ORD

 +2        KILL PSD,PSDER,PSDREC,PSDRN,PSDT,PSDTN,QTY,WQTY,X,Y

 +3        QUIT 

UPDATE    ;update 58.8 and 58.81

 +1       ;updating drug balance in 58.8

 +2        FOR 

               LOCK +^PSD(58.8,NAOU,1,PSDR,0):$SELECT($GET(DILOCKTM)>0:DILOCKTM,1:3)

              IF $TEST

                   QUIT 

 +3        DO NOW^%DTC

           SET (PSDTN,PSDT)=+%

 +4        SET BAL=$PIECE(^PSD(58.8,NAOU,1,PSDR,0),"^",4)

           SET $PIECE(^(0),"^",4)=$PIECE(^(0),"^",4)-PSDQ

 +5        LOCK -^PSD(58.8,NAOU,1,PSDR,0)

 +6       ;update order balance

 +7       ;I $G(ORD),$D(^PSD(58.8,NAOU,1,PSDR,3,ORD,0)),PSDTYP'=9 S $P(^(0),"^",22)=$P(^(0),"^",22)-PSDQ,DA=+$P(^(0),"^",17) D:$P(^(0),"^",22)=0  K DA,DIE,DR

 +8       ;.K DIE,DR S DIE="^PSD(58.81,",DR="10////12;11////1" D ^DIE K DA,DIE,DR

 +9       ;.K DA,DIE,DR S DIE="^PSD(58.8,"_NAOU_",1,"_PSDR_",3,",DA=+ORD,DA(1)=+PSDR,DA(2)=+NAOU,DR="10////12;11////1" D ^DIE K DA,DIE,DR

ADD       ;find entry number in 58.81

 +1        FOR 

               LOCK +^PSD(58.81,0):$SELECT($GET(DILOCKTM)>0:DILOCKTM,1:3)

              IF $TEST

                   QUIT 

FIND       SET PSDREC=$PIECE(^PSD(58.81,0),"^",3)+1

           IF $DATA(^PSD(58.81,PSDREC))

               SET $PIECE(^PSD(58.81,0),"^",3)=PSDREC

               GOTO FIND

 +1        KILL DIC,DLAYGO

           SET DIC(0)="L"

           SET (DIC,DLAYGO)=58.81

           SET (X,DINUM)=PSDREC

           DO ^DIC

           KILL DIC,DLAYGO

 +2        LOCK -^PSD(58.81,0)

EDIT      ;edit new transaction in 58.81

 +1        SET ^PSD(58.81,PSDREC,0)=PSDREC_"^"_PSDTYP_"^"_NAOU_"^"_PSDT_"^"_PSDR_"^"_$SELECT(PSDTYP=9:-PSDQ,1:PSDQ)_"^"_$GET(NUR1)_"^^^"_BAL_"^^^^^^"_$SELECT(PSDTYP=9:$GET(PSDRE),1:"")_"^"_$GET(PSDPN)_"^"_NAOU_"^^"_$GET(ORD)

 +2        SET ^PSD(58.81,PSDREC,9)=$GET(PAT)_"^"_NUR1_"^"_OQTY_"^"_$GET(WQTY)_"^"_$GET(LQTY)_"^"_$GET(NUR2)_"^"_BAL

 +3       ;S:PATL ^PSD(58.81,PSDREC,9.5)=PATL

 +4        SET ^PSD(58.81,PSDREC,"CS")=1

 +5        KILL DA,DIK

           SET DA=PSDREC

           SET DIK="^PSD(58.81,"

           DO IX^DIK

           KILL DA,DIK

 +6        IF PSDTYP'=17

               DO ERR

 +7        QUIT 

ERR       ;err log update

 +1        FOR 

               LOCK +^PSD(58.89,0):$SELECT($GET(DILOCKTM)>0:DILOCKTM,1:3)

              IF $TEST

                   QUIT 

FIND9      SET PSDER=$PIECE(^PSD(58.89,0),"^",3)+1

           IF $DATA(^PSD(58.89,PSDER))

               SET $PIECE(^PSD(58.89,0),"^",3)=PSDER

               GOTO FIND9

 +1        KILL DIC,DLAYGO

           SET DIC(0)="L"

           SET (DIC,DLAYGO)=58.89

           SET (X,DINUM)=PSDER

           DO ^DIC

           KILL DIC,DLAYGO

 +2        LOCK -^PSD(58.89,0)

EDIT9     ;edit error log

 +1        KILL DA,DIE,DR

           SET DA=PSDER

           SET DIE=58.89

           SET DR="1////"_PSDREC_";2////"_PSDT_";6////"_NAOU

           DO ^DIE

           KILL DA,DIE,DR

 +2        SET PHARM1=NUR1

           SET QTY=PSDQ

 +3        IF $GET(NAOUN)']""

               SET NAOUN=$PIECE($GET(^PSD(58.8,NAOU,0)),U)

           DO ^PSDRFM

 +4        QUIT