- 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