APSPOST7.m

APSPOST7 ; IHS/DSD/ENM - OUTPATIENT CONV DIC(51 - PS(51 ;  [ 09/08/97  2:05 PM ]

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

EP ;

 ;W !,"I am now moving ^DIC(51) (MEDICATION INSTRUCTION) to ^PS(51)..." ;IHS/DSD/ENM 01/08/97

 I $P($G(^PS(59.7,1,9999999)),"^",3)]"" Q  ;IHS/DSD/ENM 03/19/97

 S ^DIC(51,0,"GL")="^PS(51,",%X="^DIC(51,",%Y="^PS(51," D %XY^%RCR

 K ^PS(51,"%"),^PS(51,"%D"),^PS(51,0,"DD"),^PS(51,0,"DEL"),^PS(51,0,"GL"),^PS(51,0,"LAYGO"),^PS(51,0,"WR") ;IHS/DSD/ENM 09/08/97

ENM ;NEXT LINE WILL REINDEX THE 'A' XREF

 S DIK="^PS(51,",DIK(1)=".01" D ENALL^DIK K DIK ;IHS/DSD/ENM 03/19/97

 ;S DIK="^PS(51," D IXALL^DIK ;IHS/DSD/ENM 03/19/97 REINDEX ALL XREF'S

 D NOW^%DTC S $P(^PS(59.7,1,9999999),"^",3)=%,$P(^PS(59.7,1,9999999),"^",4)=$P($G(^PS(51,0)),"^",3) ;IHS/DSD/ENM 03/19/97 ADD ENTRY TO PHARMACY SYSTEM FILE

 Q

NDC ;NEXT LINE WILL REINDEX THE 'ZNDC' XREF ON THE 'NDC' FLD 31 IN F50

 S DIK="^PSDRUG(",DIK(1)="31^ZNDC" D ENALL^DIK K DIK ;IHS/DSD/ENM 04/02/97

 Q

APSPOST7  ; IHS/DSD/ENM - OUTPATIENT CONV DIC(51 - PS(51 ;  [ 09/08/97  2:05 PM ]

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

EP        ;

 +1       ;W !,"I am now moving ^DIC(51) (MEDICATION INSTRUCTION) to ^PS(51)..." ;IHS/DSD/ENM 01/08/97

 +2       ;IHS/DSD/ENM 03/19/97

           IF $PIECE($GET(^PS(59.7,1,9999999)),"^",3)]""

               QUIT 

 +3        SET ^DIC(51,0,"GL")="^PS(51,"

           SET %X="^DIC(51,"

           SET %Y="^PS(51,"

           DO %XY^%RCR

 +4       ;IHS/DSD/ENM 09/08/97

           KILL ^PS(51,"%"),^PS(51,"%D"),^PS(51,0,"DD"),^PS(51,0,"DEL"),^PS(51,0,"GL"),^PS(51,0,"LAYGO"),^PS(51,0,"WR")

ENM       ;NEXT LINE WILL REINDEX THE 'A' XREF

 +1       ;IHS/DSD/ENM 03/19/97

           SET DIK="^PS(51,"

           SET DIK(1)=".01"

           DO ENALL^DIK

           KILL DIK

 +2       ;S DIK="^PS(51," D IXALL^DIK ;IHS/DSD/ENM 03/19/97 REINDEX ALL XREF'S

 +3       ;IHS/DSD/ENM 03/19/97 ADD ENTRY TO PHARMACY SYSTEM FILE

           DO NOW^%DTC

           SET $PIECE(^PS(59.7,1,9999999),"^",3)=%

           SET $PIECE(^PS(59.7,1,9999999),"^",4)=$PIECE($GET(^PS(51,0)),"^",3)

 +4        QUIT 

NDC       ;NEXT LINE WILL REINDEX THE 'ZNDC' XREF ON THE 'NDC' FLD 31 IN F50

 +1       ;IHS/DSD/ENM 04/02/97

           SET DIK="^PSDRUG("

           SET DIK(1)="31^ZNDC"

           DO ENALL^DIK

           KILL DIK

 +2        QUIT