Routine: PSDORN0

PSDORN0 ;BIR/JPW,LTL-Nurse CS Order Request Entry (continued); 16 Feb 95

 ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97

DIE ;create the order request

 S:$G(ORD)<2 PSDEM=1

 S:'$D(^PSD(58.8,NAOU,1,PSDR,3,0)) ^(0)="^58.800118A^^"

 S PSDA=$P(^PSD(58.8,NAOU,1,PSDR,3,0),"^",3)+1 I $D(^PSD(58.8,NAOU,1,PSDR,3,PSDA)) S $P(^PSD(58.8,NAOU,1,PSDR,3,0),"^",3)=$P(^PSD(58.8,NAOU,1,PSDR,3,0),"^",3)+1 G DIE

 K DA,DIC,DIE,DD,DR,DO S DIC(0)="L",(DIC,DIE)="^PSD(58.8,"_NAOU_",1,"_PSDR_",3,",DA(2)=NAOU,DA(1)=PSDR,(X,DINUM)=PSDA D FILE^DICN K DIC

 D NOW^%DTC S PSDT=+$E(%,1,12) W ?10,!!,"processing now..."

 I $G(PAT),$G(PSD(2)),$O(^PSD(58.81,PSD(2),2,0)),'$G(PSD(4)) S ^PSD(58.8,NAOU,1,PSDR,3,PSDA,1,0)=^PSD(58.81,PSD(2),2,0) D

 .F WORD=0:0 S WORD=$O(^PSD(58.81,PSD(2),2,WORD)) Q:'WORD  S ^PSD(58.8,NAOU,1,PSDR,3,PSDA,1,WORD,0)=^PSD(58.81,PSD(2),2,WORD,0)

 S DA=PSDA,DA(1)=PSDR,DA(2)=NAOU,DR="1////"_PSDT_";2////"_+PSDS_";3////"_PSDUZ_";10////1;5////"_PSDQTY_";24////"_$G(PSDEM)_";13//"_$G(PSDR(1)) D ^DIE K DIE,DR,WORD

PSDORN0   ;BIR/JPW,LTL-Nurse CS Order Request Entry (continued); 16 Feb 95

 +1       ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97

DIE       ;create the order request

 +1        IF $GET(ORD)<2

               SET PSDEM=1

 +2        IF '$DATA(^PSD(58.8,NAOU,1,PSDR,3,0))

               SET ^(0)="^58.800118A^^"

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

           IF $DATA(^PSD(58.8,NAOU,1,PSDR,3,PSDA))

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

               GOTO DIE

 +4        KILL DA,DIC,DIE,DD,DR,DO

           SET DIC(0)="L"

           SET (DIC,DIE)="^PSD(58.8,"_NAOU_",1,"_PSDR_",3,"

           SET DA(2)=NAOU

           SET DA(1)=PSDR

           SET (X,DINUM)=PSDA

           DO FILE^DICN

           KILL DIC

 +5        DO NOW^%DTC

           SET PSDT=+$EXTRACT(%,1,12)

           WRITE ?10,!!,"processing now..."

 +6        IF $GET(PAT)

               IF $GET(PSD(2))

                   IF $ORDER(^PSD(58.81,PSD(2),2,0))

                       IF '$GET(PSD(4))

                           SET ^PSD(58.8,NAOU,1,PSDR,3,PSDA,1,0)=^PSD(58.81,PSD(2),2,0)

                           Begin DoDot:1

 +7                            FOR WORD=0:0

                                   SET WORD=$ORDER(^PSD(58.81,PSD(2),2,WORD))

                                   IF 'WORD

                                       QUIT

                                   SET ^PSD(58.8,NAOU,1,PSDR,3,PSDA,1,WORD,0)=^PSD(58.81,PSD(2),2,WORD,0)

                           End DoDot:1

 +8        SET DA=PSDA

           SET DA(1)=PSDR

           SET DA(2)=NAOU

           SET DR="1////"_PSDT_";2////"_+PSDS_";3////"_PSDUZ_";10////1;5////"_PSDQTY_";24////"_$GET(PSDEM)_";13//"_$GET(PSDR(1))

           DO ^DIE

           KILL DIE,DR,WORD

 +9        QUIT

PSDORN0.m