APSPVST.m

APSPVST ; IHS/DSD/ENM - CHECK PRESCRIPTION FILE FOR VMED LINKAGE ;  [ 09/03/97   1:30 PM ]

 ;;6.0;IHS PHARMACY MODIFICATIONS;;09/03/97

 ;

 ;------------------------------------------------------------------

START ;

 D ^XBKVAR

 S APSPVST("BD")=0

 S APSPVST("BD")=$S($D(^TMP("APSPVST","LAST DATE")):^TMP("APSPVST","LAST DATE"),1:$O(^AUPNVSIT("B",0)))

 G:'APSPVST("BD") END

 D ASK

 G:$D(APSPVST("QFLG")) END

 D DATE

END D EOJ

 Q

 ;-------------------------------------------------------------------

EN ;

 D ^XBKVAR

 D ASK

 G:$D(APSPVST("QFLG")) ENX

 D CHECK D:$D(APSPVST("DIFFLG")) FIX

ENX D EOJ

 Q

 ;

ASK ;

 S DIR(0)="S^I:IHS;C:CONTRACT;T:TRIBAL;O:OTHER;6:638;V:VA",DIR("A")="DEFAULT TYPE OF VISIT TO CREATE"

 D ^DIR

 K DIR I $D(DIRUT) S APSPVST("QFLG")=1 K DIRUT,DTOUT,DUOUT,BD,ED G ASKX

 S APSPVST("APCDTYPE")=Y K X,Y

ASKX ;

 Q

DATE ;

 W !!!,"No. of RX's Checked : ",?40,"No. of V Med's Created : ",!

 S (APSPVST("COUNT"),APSPVST("DLCOUNT"))=0

 F APSPVST("DATE")=(APSPVST("BD")-1):0 S APSPVST("DATE")=$O(^PSRX("AD",APSPVST("DATE"))) Q:'APSPVST("DATE")  D RX

 W APSPVST("COUNT"),?40,APSPVST("DLCOUNT"),$C(13)

 W !!,"All done ..."

 Q

RX ;

 ;APSPVST("IRXN") IS THE SUBSCRIPT PRESCRIPTION NUMBER

 F APSPVST("IRXN")=0:0 S APSPVST("IRXN")=$O(^PSRX("AD",APSPVST("DATE"),APSPVST("IRXN"))) Q:APSPVST("IRXN")=""  S APSPVST("RFN")=$O(^(APSPVST("IRXN"),"")) D CHECK D:$D(APSPVST("DIFFLG")) FIX

 Q

CHECK ;

 S APSPVST("COUNT")=APSPVST("COUNT")+1

 W APSPVST("COUNT"),?40,APSPVST("DLCOUNT"),$C(13)

 K APSPVST("PSDFN"),APSPVST("VMDFN"),APSPVST("VDFN"),APSPVST("DIFFLG")

 I $D(^PSRX(APSPVST("IRXN"),0)),$P(^(0),U,2) S APSPVST("PSDFN")=$P(^(0),U,2)

 Q:'$D(APSPVST("PSDFN"))

 I APSPVST("RFN")>0,$S('$D(^PSRX(APSPVST("IRXN"),1,APSPVST("RFN"),999999911)):1,^(999999911)="":1,1:0) S APSPVST("DIFFLG")=1

 I APSPVST("RFN")=0,$S('$D(^PSRX(APSPVST("IRXN"),999999911)):1,^(999999911)="":1,1:0) S APSPVST("DIFFLG")=1

 Q

FIX ;

 D INIT ; Initializes variables needed to create V Med and Visit Entry

 D ^APSPVST1 K APCDALVR ;Creates V Med entry and possibly Visit

 S APSPVST("DLCOUNT")=APSPVST("DLCOUNT")+1

 Q

INIT ;

 K APCDALVR

 S APSPVST("RX0")=^PSRX(APSPVST("IRXN"),0)

 S APCDALVR("APCDPAT")=APSPVST("PSDFN")

 S APCDALVR("APCDDATE")=$S(APSPVST("RFN")=0:$P(APSPVST("RX0"),U,13),1:$P(^PSRX(APSPVST("IRXN"),1,APSPVST("RFN"),0),U,1))

 S APCDALVR("APCDLOC")=DUZ(2)

 S APCDALVR("APCDTYPE")=APSPVST("APCDTYPE")

 S APCDALVR("APCDCAT")=$S($P(APSPVST("RX0"),U,3)=1:"A",1:"I")

 Q 

EOJ ;

 K APSPVST

 Q

APSPVST   ; IHS/DSD/ENM - CHECK PRESCRIPTION FILE FOR VMED LINKAGE ;  [ 09/03/97   1:30 PM ]

 +1       ;;6.0;IHS PHARMACY MODIFICATIONS;;09/03/97

 +2       ;

 +3       ;------------------------------------------------------------------

START     ;

 +1        DO ^XBKVAR

 +2        SET APSPVST("BD")=0

 +3        SET APSPVST("BD")=$SELECT($DATA(^TMP("APSPVST","LAST DATE")):^TMP("APSPVST","LAST DATE"),1:$ORDER(^AUPNVSIT("B",0)))

 +4        IF 'APSPVST("BD")

               GOTO END

 +5        DO ASK

 +6        IF $DATA(APSPVST("QFLG"))

               GOTO END

 +7        DO DATE

END        DO EOJ

 +1        QUIT 

 +2       ;-------------------------------------------------------------------

EN        ;

 +1        DO ^XBKVAR

 +2        DO ASK

 +3        IF $DATA(APSPVST("QFLG"))

               GOTO ENX

 +4        DO CHECK

           IF $DATA(APSPVST("DIFFLG"))

               DO FIX

ENX        DO EOJ

 +1        QUIT 

 +2       ;

ASK       ;

 +1        SET DIR(0)="S^I:IHS;C:CONTRACT;T:TRIBAL;O:OTHER;6:638;V:VA"

           SET DIR("A")="DEFAULT TYPE OF VISIT TO CREATE"

 +2        DO ^DIR

 +3        KILL DIR

           IF $DATA(DIRUT)

               SET APSPVST("QFLG")=1

               KILL DIRUT,DTOUT,DUOUT,BD,ED

               GOTO ASKX

 +4        SET APSPVST("APCDTYPE")=Y

           KILL X,Y

ASKX      ;

 +1        QUIT 

DATE      ;

 +1        WRITE !!!,"No. of RX's Checked : ",?40,"No. of V Med's Created : ",!

 +2        SET (APSPVST("COUNT"),APSPVST("DLCOUNT"))=0

 +3        FOR APSPVST("DATE")=(APSPVST("BD")-1):0

               SET APSPVST("DATE")=$ORDER(^PSRX("AD",APSPVST("DATE")))

               IF 'APSPVST("DATE")

                   QUIT 

               DO RX

 +4        WRITE APSPVST("COUNT"),?40,APSPVST("DLCOUNT"),$CHAR(13)

 +5        WRITE !!,"All done ..."

 +6        QUIT 

RX        ;

 +1       ;APSPVST("IRXN") IS THE SUBSCRIPT PRESCRIPTION NUMBER

 +2        FOR APSPVST("IRXN")=0:0

               SET APSPVST("IRXN")=$ORDER(^PSRX("AD",APSPVST("DATE"),APSPVST("IRXN")))

               IF APSPVST("IRXN")=""

                   QUIT 

               SET APSPVST("RFN")=$ORDER(^(APSPVST("IRXN"),""))

               DO CHECK

               IF $DATA(APSPVST("DIFFLG"))

                   DO FIX

 +3        QUIT 

CHECK     ;

 +1        SET APSPVST("COUNT")=APSPVST("COUNT")+1

 +2        WRITE APSPVST("COUNT"),?40,APSPVST("DLCOUNT"),$CHAR(13)

 +3        KILL APSPVST("PSDFN"),APSPVST("VMDFN"),APSPVST("VDFN"),APSPVST("DIFFLG")

 +4        IF $DATA(^PSRX(APSPVST("IRXN"),0))

               IF $PIECE(^(0),U,2)

                   SET APSPVST("PSDFN")=$PIECE(^(0),U,2)

 +5        IF '$DATA(APSPVST("PSDFN"))

               QUIT 

 +6        IF APSPVST("RFN")>0

               IF $SELECT('$DATA(^PSRX(APSPVST("IRXN"),1,APSPVST("RFN"),999999911)):1,^(999999911)="":1,1:0)

                   SET APSPVST("DIFFLG")=1

 +7        IF APSPVST("RFN")=0

               IF $SELECT('$DATA(^PSRX(APSPVST("IRXN"),999999911)):1,^(999999911)="":1,1:0)

                   SET APSPVST("DIFFLG")=1

 +8        QUIT 

FIX       ;

 +1       ; Initializes variables needed to create V Med and Visit Entry

           DO INIT

 +2       ;Creates V Med entry and possibly Visit

           DO ^APSPVST1

           KILL APCDALVR

 +3        SET APSPVST("DLCOUNT")=APSPVST("DLCOUNT")+1

 +4        QUIT 

INIT      ;

 +1        KILL APCDALVR

 +2        SET APSPVST("RX0")=^PSRX(APSPVST("IRXN"),0)

 +3        SET APCDALVR("APCDPAT")=APSPVST("PSDFN")

 +4        SET APCDALVR("APCDDATE")=$SELECT(APSPVST("RFN")=0:$PIECE(APSPVST("RX0"),U,13),1:$PIECE(^PSRX(APSPVST("IRXN"),1,APSPVST("RFN"),0),U,1))

 +5        SET APCDALVR("APCDLOC")=DUZ(2)

 +6        SET APCDALVR("APCDTYPE")=APSPVST("APCDTYPE")

 +7        SET APCDALVR("APCDCAT")=$SELECT($PIECE(APSPVST("RX0"),U,3)=1:"A",1:"I")

 +8        QUIT 

EOJ       ;

 +1        KILL APSPVST

 +2        QUIT