APSGIOU.m

APSGIOU ;IHS/ITSC/ENM - STUFF IOU IN DRUG FILE [ 01/14/2002  10:42 AM ]

 ;;3.2;INPATIENT MEDICATIONS;**3**;12/28/01

 D CREATE

 D EXREF

 W !,".......Done!",!

 Q

CREATE ;Create Application Package Use settings for each local drug

 S IFN=0

 W !,"One Moment Please!  I need to create 'Application Package Use' settings for all of your local drugs.....",!

 H 4

 F  S IFN=$O(^PSDRUG(IFN)) Q:'IFN  D P1

 W !,"Done!",!

 Q

P1 ;

 S APSID=$G(^PSDRUG(IFN,"I")) ;INACTIVE DRUG CHECK

 Q:+APSID

 S $P(^PSDRUG(IFN,2),"^",3)="IOU",^PSDRUG("IU","IOU",IFN)=""

 Q

EXREF ;

 ;NEXT LINE WILL REINDEX THE 'IU and AIU' XREF's ON FLD 63 IN FILE 50

 W !,"Re-indexing the 'IU', 'AIUI', 'AIUO' and 'AIUU' cross-references",!,"in your Drug File...",!

 K ^PSDRUG("IU"),^PSDRUG("AIUI"),^PSDRUG("AIUO"),^PSDRUG("AIUU")

 S DIK="^PSDRUG(",DIK(1)="63^IU^AIU" D ENALL^DIK K DIK

 W !,?20,"Re-Indexing Done!",!

 Q

LIST ;LIST LOCAL DRUGS WITH IOU IN 'IU' XREF

 S IFN=0,CT=1

 F  S IFN=$O(^PSDRUG("IU","OI",IFN))  Q:'IFN  S DNAME=$P(^PSDRUG(IFN,0),"^",1) D CK

 Q

CK S ND=$G(^PSDRUG(IFN,"ND"))

 I ND]"" S NDFIRN=+$P(^("ND"),"^",1),NDNAM=$P(^PSNDF(NDFIRN,0),"^")

 I ND]"" W !,CT,?5,IFN,?15,NDNAM S CT=CT+1

 Q

APSGIOU   ;IHS/ITSC/ENM - STUFF IOU IN DRUG FILE [ 01/14/2002  10:42 AM ]

 +1       ;;3.2;INPATIENT MEDICATIONS;**3**;12/28/01

 +2        DO CREATE

 +3        DO EXREF

 +4        WRITE !,".......Done!",!

 +5        QUIT 

CREATE    ;Create Application Package Use settings for each local drug

 +1        SET IFN=0

 +2        WRITE !,"One Moment Please!  I need to create 'Application Package Use' settings for all of your local drugs.....",!

 +3        HANG 4

 +4        FOR 

               SET IFN=$ORDER(^PSDRUG(IFN))

               IF 'IFN

                   QUIT 

               DO P1

 +5        WRITE !,"Done!",!

 +6        QUIT 

P1        ;

 +1       ;INACTIVE DRUG CHECK

           SET APSID=$GET(^PSDRUG(IFN,"I"))

 +2        IF +APSID

               QUIT 

 +3        SET $PIECE(^PSDRUG(IFN,2),"^",3)="IOU"

           SET ^PSDRUG("IU","IOU",IFN)=""

 +4        QUIT 

EXREF     ;

 +1       ;NEXT LINE WILL REINDEX THE 'IU and AIU' XREF's ON FLD 63 IN FILE 50

 +2        WRITE !,"Re-indexing the 'IU', 'AIUI', 'AIUO' and 'AIUU' cross-references",!,"in your Drug File...",!

 +3        KILL ^PSDRUG("IU"),^PSDRUG("AIUI"),^PSDRUG("AIUO"),^PSDRUG("AIUU")

 +4        SET DIK="^PSDRUG("

           SET DIK(1)="63^IU^AIU"

           DO ENALL^DIK

           KILL DIK

 +5        WRITE !,?20,"Re-Indexing Done!",!

 +6        QUIT 

LIST      ;LIST LOCAL DRUGS WITH IOU IN 'IU' XREF

 +1        SET IFN=0

           SET CT=1

 +2        FOR 

               SET IFN=$ORDER(^PSDRUG("IU","OI",IFN))

               IF 'IFN

                   QUIT 

               SET DNAME=$PIECE(^PSDRUG(IFN,0),"^",1)

               DO CK

 +3        QUIT 

CK         SET ND=$GET(^PSDRUG(IFN,"ND"))

 +1        IF ND]""

               SET NDFIRN=+$PIECE(^("ND"),"^",1)

               SET NDNAM=$PIECE(^PSNDF(NDFIRN,0),"^")

 +2        IF ND]""

               WRITE !,CT,?5,IFN,?15,NDNAM

               SET CT=CT+1

 +3        QUIT