PSDORN0.m

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

 ;;3.0;CONTROLLED SUBSTANCES ;**79**;13 Feb 97;Build 20

DIE ;create the order request

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

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

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

DIE2 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 DIE2

 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

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

 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

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PSDORN0   1135     printed  Mar 13, 2025@20:52:16                                                                                                                                                                                                     Page 2

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

 +1       ;;3.0;CONTROLLED SUBSTANCES ;**79**;13 Feb 97;Build 20

DIE       ;create the order request

 +1        if $GET(ORD)<2

               SET PSDEM=1

 +2        FOR 

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

              IF $TEST

                   QUIT 

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

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

DIE2       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 DIE2

 +1        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

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

 +3        DO NOW^%DTC

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

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

 +4        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

 +5                            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

 +6        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

 +7        QUIT