APSPOST2.m

APSPOST2 ; IHS/DSD/ENM - OUTPATIENT PHARM 6/200 CONV ;  [ 09/03/97   1:30 PM ]

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

EP ;EP - Build Provider Class Table

 F APSPZ=1:1 D EP1 Q:APSPZZ="" 

 Q

EP1 ;EP

 S APSPZZ=$P($T(CLASS+APSPZ),";;",2)

 I APSPZZ'="" S APSP(APSPZZ)=""

 Q

ZZE ;GET PROVIDER CLASS DATA

 ;S $P(^PS(59.7,1,9999999),"^",2)=NPV,APSPV=""

 ;S ^TMP("PSOP")=NPV,APSPV=""

 S APSPV=""

 S APSP1=$P($G(^DIC(6,NPV,0)),"^",4)

 I APSP1="" S APSP2="",APSPV="" Q

 S APSP2=$P($G(^DIC(7,APSP1,0)),"^")

 I $D(APSP(APSP2)) S APSPV="1"

 Q

MSG ;EP - SEND E-MSG TO "ADAM ADAM"...Set text lines = APSPM1,APSPM2,APSPM3

 K XMY S XMSUB="OutPatient Pharmacy v6.0 Conversion Update",XMY("ADAM,ADAM")="",XMTEXT="APSPMSG(",%H=$H D YX^%DTC

 S APSPMSG(1,0)=APSPM1,APSPMSG(2,0)=APSPM2,APSPMSG(3,0)=APSPM3_Y_"."

 D ^XMD K APSPMSG

 Q

CLASS ;

 ;;ANESTHESIOLOGIST

 ;;CARDIOLOGIST

 ;;CONTRACT PSHCHIATRIST

 ;;DENTIST

 ;;DERMATOLOGIST

 ;;FAMILY PRACTICE

 ;;INTERNAL MEDICINE

 ;;NEPHROLOGY

 ;;NEUROLOGIST

 ;;NURSE MIDWIFE

 ;;NURSE PRACTITIONER

 ;;OB/GYN

 ;;OB/GYN (CONTRACT)

 ;;OPHTHALMOLOGIST

 ;;OPTOMETRIST

 ;;ORTHOPEDIST

 ;;OSTEOPATH

 ;;OTOLARYNGOLOGIST

 ;;PATHOLOGIST

 ;;PEDIATRIC NURSE PRACT.

 ;;PEDIATRICIAN

 ;;PHARMACY PRACTIONER

 ;;PHYSICIAN

 ;;PHYSICIAN (CONTRACT)

 ;;PHYSICIAN (TRIBAL)

 ;;PHYSICIAN ASSISTANT

 ;;PODIATRIST

 ;;PODIATRIST (CONTRACT)

 ;;PSYCHIATRIST

 ;;RADIOLOGIST

 ;;SURGEON

 ;;UROLOGIST

 Q

APSPOST2  ; IHS/DSD/ENM - OUTPATIENT PHARM 6/200 CONV ;  [ 09/03/97   1:30 PM ]

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

EP        ;EP - Build Provider Class Table

 +1        FOR APSPZ=1:1

               DO EP1

               IF APSPZZ=""

                   QUIT 

 +2        QUIT 

EP1       ;EP

 +1        SET APSPZZ=$PIECE($TEXT(CLASS+APSPZ),";;",2)

 +2        IF APSPZZ'=""

               SET APSP(APSPZZ)=""

 +3        QUIT 

ZZE       ;GET PROVIDER CLASS DATA

 +1       ;S $P(^PS(59.7,1,9999999),"^",2)=NPV,APSPV=""

 +2       ;S ^TMP("PSOP")=NPV,APSPV=""

 +3        SET APSPV=""

 +4        SET APSP1=$PIECE($GET(^DIC(6,NPV,0)),"^",4)

 +5        IF APSP1=""

               SET APSP2=""

               SET APSPV=""

               QUIT 

 +6        SET APSP2=$PIECE($GET(^DIC(7,APSP1,0)),"^")

 +7        IF $DATA(APSP(APSP2))

               SET APSPV="1"

 +8        QUIT 

MSG       ;EP - SEND E-MSG TO "ADAM ADAM"...Set text lines = APSPM1,APSPM2,APSPM3

 +1        KILL XMY

           SET XMSUB="OutPatient Pharmacy v6.0 Conversion Update"

           SET XMY("ADAM,ADAM")=""

           SET XMTEXT="APSPMSG("

           SET %H=$HOROLOG

           DO YX^%DTC

 +2        SET APSPMSG(1,0)=APSPM1

           SET APSPMSG(2,0)=APSPM2

           SET APSPMSG(3,0)=APSPM3_Y_"."

 +3        DO ^XMD

           KILL APSPMSG

 +4        QUIT 

CLASS     ;

 +1       ;;ANESTHESIOLOGIST

 +2       ;;CARDIOLOGIST

 +3       ;;CONTRACT PSHCHIATRIST

 +4       ;;DENTIST

 +5       ;;DERMATOLOGIST

 +6       ;;FAMILY PRACTICE

 +7       ;;INTERNAL MEDICINE

 +8       ;;NEPHROLOGY

 +9       ;;NEUROLOGIST

 +10      ;;NURSE MIDWIFE

 +11      ;;NURSE PRACTITIONER

 +12      ;;OB/GYN

 +13      ;;OB/GYN (CONTRACT)

 +14      ;;OPHTHALMOLOGIST

 +15      ;;OPTOMETRIST

 +16      ;;ORTHOPEDIST

 +17      ;;OSTEOPATH

 +18      ;;OTOLARYNGOLOGIST

 +19      ;;PATHOLOGIST

 +20      ;;PEDIATRIC NURSE PRACT.

 +21      ;;PEDIATRICIAN

 +22      ;;PHARMACY PRACTIONER

 +23      ;;PHYSICIAN

 +24      ;;PHYSICIAN (CONTRACT)

 +25      ;;PHYSICIAN (TRIBAL)

 +26      ;;PHYSICIAN ASSISTANT

 +27      ;;PODIATRIST

 +28      ;;PODIATRIST (CONTRACT)

 +29      ;;PSYCHIATRIST

 +30      ;;RADIOLOGIST

 +31      ;;SURGEON

 +32      ;;UROLOGIST

 +33       QUIT