APSPPOSH.m

APSPPOSH ;IHS/CIA/PLS - Point of Sale Event Hook;21-Mar-2007 16:21;SM

 ;;7.0;IHS PHARMACY MODIFICATIONS;**1005**;01/22/2004

EN(DATA) N MSG

 I $D(DATA)=1 M MSG=@DATA

 E  M MSG=DATA

 ;D LOG(.MSG)

 ;D TASK

 Q

 ; Log data

LOG(ARY,NMSP) ;EP

 S NMSP="ABSPHOOK"_$S($G(NMSP)="":"",1:"."_NMSP)

 L +^XTMP("ABSPHOOK"):2

 M ^($O(^XTMP("ABSPHOOK",""),-1)+1)=ARY

 L -^XTMP("ABSPHOOK")

 Q

 ; Taskman Entry Point

TASK N SEG,LP,DL1,DL2,ERR,ACTION,IEN,RET

 Q:$G(PSOFROM)="PARTIAL"  ; Don't process partial fills

 S ZTREQ="@"

 S ERR=""

 S LP=0

 S SEG=$$SEG("MSH",.LP)

 Q:'LP

 S DL1=$E(SEG,4),DL2=$E(SEG,5)

 Q:$P(SEG,DL1,3)'="PHARMACY"

 S SEG=$$SEG("ORC",.LP)

 Q:'LP

 S IEN=$P($P(SEG,DL1,4),U)  ;Prescription IEN

 S ACTION=$P(SEG,DL1,2)  ;Order Control

 I ACTION?2U,$L($T(@ACTION)) D @ACTION

 Q

 ;

SN ; New Order

 S RET=$$EN^APSQBRES(IEN,"","A")

 Q

OD ; Discontinued Order

 S RET=$$EN^APSQBRES(IEN,"","D")

 Q

XX ; Edited Order

 S RET=$$EN^APSQBRES(IEN,"","A")

 Q

 ;

ZD ; Refill Order/Return to Stock

 S REF=$$EN^APSQBRES(IEN,$O(^PSRX(IEN,1,$C(1)),-1),"A")

 Q

OH ; Hold Order

 S RET=$$EN^APSQBRES(IEN,"","D")

 Q

 ; Return specified segment, starting at line LP

SEG(TYP,LP) ;

 F  S LP=$O(MSG(LP)) Q:'LP  Q:$E(MSG(LP),1,$L(TYP))=TYP

 Q $S(LP:MSG(LP),1:"")

APSPPOSH  ;IHS/CIA/PLS - Point of Sale Event Hook;21-Mar-2007 16:21;SM

 +1       ;;7.0;IHS PHARMACY MODIFICATIONS;**1005**;01/22/2004

EN(DATA)   NEW MSG

 +1        IF $DATA(DATA)=1

               MERGE MSG=@DATA

 +2       IF '$TEST

               MERGE MSG=DATA

 +3       ;D LOG(.MSG)

 +4       ;D TASK

 +5        QUIT 

 +6       ; Log data

LOG(ARY,NMSP) ;EP

 +1        SET NMSP="ABSPHOOK"_$SELECT($GET(NMSP)="":"",1:"."_NMSP)

 +2        LOCK +^XTMP("ABSPHOOK"):2

 +3        MERGE ^($ORDER(^XTMP("ABSPHOOK",""),-1)+1)=ARY

 +4        LOCK -^XTMP("ABSPHOOK")

 +5        QUIT 

 +6       ; Taskman Entry Point

TASK       NEW SEG,LP,DL1,DL2,ERR,ACTION,IEN,RET

 +1       ; Don't process partial fills

           IF $GET(PSOFROM)="PARTIAL"

               QUIT 

 +2        SET ZTREQ="@"

 +3        SET ERR=""

 +4        SET LP=0

 +5        SET SEG=$$SEG("MSH",.LP)

 +6        IF 'LP

               QUIT 

 +7        SET DL1=$EXTRACT(SEG,4)

           SET DL2=$EXTRACT(SEG,5)

 +8        IF $PIECE(SEG,DL1,3)'="PHARMACY"

               QUIT 

 +9        SET SEG=$$SEG("ORC",.LP)

 +10       IF 'LP

               QUIT 

 +11      ;Prescription IEN

           SET IEN=$PIECE($PIECE(SEG,DL1,4),U)

 +12      ;Order Control

           SET ACTION=$PIECE(SEG,DL1,2)

 +13       IF ACTION?2U

               IF $LENGTH($TEXT(@ACTION))

                   DO @ACTION

 +14       QUIT 

 +15      ;

SN        ; New Order

 +1        SET RET=$$EN^APSQBRES(IEN,"","A")

 +2        QUIT 

OD        ; Discontinued Order

 +1        SET RET=$$EN^APSQBRES(IEN,"","D")

 +2        QUIT 

XX        ; Edited Order

 +1        SET RET=$$EN^APSQBRES(IEN,"","A")

 +2        QUIT 

 +3       ;

ZD        ; Refill Order/Return to Stock

 +1        SET REF=$$EN^APSQBRES(IEN,$ORDER(^PSRX(IEN,1,$CHAR(1)),-1),"A")

 +2        QUIT 

OH        ; Hold Order

 +1        SET RET=$$EN^APSQBRES(IEN,"","D")

 +2        QUIT 

 +3       ; Return specified segment, starting at line LP

SEG(TYP,LP) ;

 +1        FOR 

               SET LP=$ORDER(MSG(LP))

               IF 'LP

                   QUIT 

               IF $EXTRACT(MSG(LP),1,$LENGTH(TYP))=TYP

                   QUIT 

 +2        QUIT $SELECT(LP:MSG(LP),1:"")