APSPCO1.m

APSPCO1 ; IHS/MSC/PLS - List Manager Complete Orders, CON'T ;24-Jul-2013 08:46;PLS

 ;;7.0;IHS PHARMACY MODIFICATIONS;**1013**;Sep 23, 2004;Build 74

 ;=================================================================

 Q

 ; Input: EFLG - Edit flag

PMTLLST(EFLG) ;EP- Prompt user for location restriction list

 N DIC,Y

 S DIC=9009033.6,DIC(0)="AEMQZ"_$S($G(EFLG):"L",1:"")

 I $G(EFLG) D

 .S DIC("A")="Select/Create location restriction list: "

 E  S DIC("A")="Select location restriction list('^' to ignore): "

 D ^DIC

 Q $S(Y>0:+Y,1:0)

 ;

EDTLLST ;EP- Create/Edit a location restriction list

 N DA,DIE,DR,DIDEL,DUOUT,DLAYGO

 S DLAYGO=9009033.6

 S DA=$$PMTLLST(1)

 Q:DA<1

 S DR=".01;1",DIE=9009033.6 D ^DIE

 Q

CHGCOM ;EP- Change comment associated with order

 N DA,DUOUT,Y,VAL,ITM,DTOUT,DIRUT,DIE,DR,LST,APSPCOQF,COM

 S DIR("A")="Select Orders by number",DIR(0)="LO^1:"_VALMCNT D ^DIR

 I $D(DUOUT) S VALMBCK="R" Q

 I +Y D FULL^VALM1 S LST=Y

 F ITM=1:1:$L(LST,",") Q:$P(LST,",",ITM)']""!($G(APSPCOQF))  S VAL=$P(LST,",",ITM) D

 .S DA=$P(@VALMAR@(VAL,"POFIEN"),U,2)

 .I '$$GET1^DIQ(52.41,DA,.01) D  Q

 ..W !,"This order has already been processed and removed from the Pending Order File!"

 .W !,"Comment for order number: "_$$GET1^DIQ(52.41,DA,.01)," on patient: "_$$GET1^DIQ(52.41,DA,1)

 .S DIE=52.41,DR="23" D ^DIE

 .S COM=$$GET1^DIQ(52.41,DA,23)

 .S COM=$S($L(COM)>30:$E(COM,1,27)_"...",1:COM)

 .D FLDTEXT^VALM10(VAL,"COMMENT",COM)

 .S APSPCO("QFLG")='+$$DIRYN^APSPUTIL("Continue: ","N",,.APSPPOP)

 S VALMBCK="R"

 Q

APSPCO1   ; IHS/MSC/PLS - List Manager Complete Orders, CON'T ;24-Jul-2013 08:46;PLS

 +1       ;;7.0;IHS PHARMACY MODIFICATIONS;**1013**;Sep 23, 2004;Build 74

 +2       ;=================================================================

 +3        QUIT 

 +4       ; Input: EFLG - Edit flag

PMTLLST(EFLG) ;EP- Prompt user for location restriction list

 +1        NEW DIC,Y

 +2        SET DIC=9009033.6

           SET DIC(0)="AEMQZ"_$SELECT($GET(EFLG):"L",1:"")

 +3        IF $GET(EFLG)

               Begin DoDot:1

 +4                SET DIC("A")="Select/Create location restriction list: "

               End DoDot:1

 +5       IF '$TEST

               SET DIC("A")="Select location restriction list('^' to ignore): "

 +6        DO ^DIC

 +7        QUIT $SELECT(Y>0:+Y,1:0)

 +8       ;

EDTLLST   ;EP- Create/Edit a location restriction list

 +1        NEW DA,DIE,DR,DIDEL,DUOUT,DLAYGO

 +2        SET DLAYGO=9009033.6

 +3        SET DA=$$PMTLLST(1)

 +4        IF DA<1

               QUIT 

 +5        SET DR=".01;1"

           SET DIE=9009033.6

           DO ^DIE

 +6        QUIT 

CHGCOM    ;EP- Change comment associated with order

 +1        NEW DA,DUOUT,Y,VAL,ITM,DTOUT,DIRUT,DIE,DR,LST,APSPCOQF,COM

 +2        SET DIR("A")="Select Orders by number"

           SET DIR(0)="LO^1:"_VALMCNT

           DO ^DIR

 +3        IF $DATA(DUOUT)

               SET VALMBCK="R"

               QUIT 

 +4        IF +Y

               DO FULL^VALM1

               SET LST=Y

 +5        FOR ITM=1:1:$LENGTH(LST,",")

               IF $PIECE(LST,",",ITM)']""!($GET(APSPCOQF))

                   QUIT 

               SET VAL=$PIECE(LST,",",ITM)

               Begin DoDot:1

 +6                SET DA=$PIECE(@VALMAR@(VAL,"POFIEN"),U,2)

 +7                IF '$$GET1^DIQ(52.41,DA,.01)

                       Begin DoDot:2

 +8                        WRITE !,"This order has already been processed and removed from the Pending Order File!"

                       End DoDot:2

                       QUIT 

 +9                WRITE !,"Comment for order number: "_$$GET1^DIQ(52.41,DA,.01)," on patient: "_$$GET1^DIQ(52.41,DA,1)

 +10               SET DIE=52.41

                   SET DR="23"

                   DO ^DIE

 +11               SET COM=$$GET1^DIQ(52.41,DA,23)

 +12               SET COM=$SELECT($LENGTH(COM)>30:$EXTRACT(COM,1,27)_"...",1:COM)

 +13               DO FLDTEXT^VALM10(VAL,"COMMENT",COM)

 +14               SET APSPCO("QFLG")='+$$DIRYN^APSPUTIL("Continue: ","N",,.APSPPOP)

               End DoDot:1

 +15       SET VALMBCK="R"

 +16       QUIT