AMHLEP3.m

AMHLEP3 ; IHS/CMI/LAB - ADD NEW CHR ACTIVITY RECORDS ;

 ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010

 ;

SAN ;EP

 D SAN1

 Q

 ;

CASE(P,R,T) ;return 1 if case already opened

 S U="^"

 I '$G(P) Q ""

 I '$G(R) Q ""

 I $G(T)="" Q ""

 NEW X,H S (X,H)=0 F  S X=$O(^AMHPCASE("AA",P,9999999-$P($P(^AMHREC(R,0),U),"."),X)) Q:X'=+X   I $P(^AMHPCASE(X,0),U,2)=T,$P(^AMHPCASE(X,0),U,8)=$$PPINT^AMHUTIL(R) S H=1

 Q H

SAN1 ;

 W:$D(IOF) @IOF

 S AMHPAT=$P(^AMHREC(AMHR,0),U,8)

 S DA=AMHR,DDSFILE=9002011,DR="[AMHVT ADD RECORD]" D ^DDS ;record info

 I $D(DIMSG) W !!,"ERROR IN SCREENMAN FORM!!" S AMHQUIT=1 K DIMSG Q

 ;check here for required items

 S AMHERROR=0

 S AMHREC=^AMHREC(AMHR,0)

 I $P(AMHREC,U,4)="" W !,"Location of Encounter Missing!" S (AMHOKAY,AMHERROR)=1

 I $P(AMHREC,U,5)="" W !,"Community of Service Missing!" S (AMHOKAY,AMHERROR)=1

 I $P(AMHREC,U,6)="" W !,"Activity Type Missing!" S (AMHOKAY,AMHERROR)=1

 I $P(AMHREC,U,7)="" W !,"Type of Contact Missing!" S (AMHOKAY,AMHERROR)=1

 S (X,Y)=0 F  S X=$O(^AMHRPROV("AD",AMHR,X)) Q:X'=+X  I $P(^AMHRPROV(X,0),U,4)="P" S Y=Y+1

 I Y=0 W !,"No primary Provider!",$C(7),$C(7) S AMHERROR=1 H 2

 I Y>1 W !,"Multiple Primary Providers!",$C(7),$C(7) W:'$G(AMHERROR) " PLEASE EDIT THIS RECORD" H 2

 I AMHERROR=1 Q

I1 ;S DA=AMHR,DDSFILE=9002011,DR="[AMH INTAKE POVS]" D ^DDS ;pov and other info collection

 ;I $D(DIMSG) W !!,"ERROR IN SCREENMAN FORM!!" S AMHQUIT=1 K DIMSG Q

 I '$D(^AMHRPRO("AD",AMHR)) W !!,"At least one POV IS REQUIRED.  Please add one.",! H 2 G SAN1

 D EP1^AMHLESAN(AMHPAT,AMHR) ;INTAKE DATA COLLECTION

TP ;

 Q

AMHLEP3   ; IHS/CMI/LAB - ADD NEW CHR ACTIVITY RECORDS ;

 +1       ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010

 +2       ;

SAN       ;EP

 +1        DO SAN1

 +2        QUIT 

 +3       ;

CASE(P,R,T) ;return 1 if case already opened

 +1        SET U="^"

 +2        IF '$GET(P)

               QUIT ""

 +3        IF '$GET(R)

               QUIT ""

 +4        IF $GET(T)=""

               QUIT ""

 +5        NEW X,H

           SET (X,H)=0

           FOR 

               SET X=$ORDER(^AMHPCASE("AA",P,9999999-$PIECE($PIECE(^AMHREC(R,0),U),"."),X))

               IF X'=+X

                   QUIT 

               IF $PIECE(^AMHPCASE(X,0),U,2)=T

                   IF $PIECE(^AMHPCASE(X,0),U,8)=$$PPINT^AMHUTIL(R)

                       SET H=1

 +6        QUIT H

SAN1      ;

 +1        IF $DATA(IOF)

               WRITE @IOF

 +2        SET AMHPAT=$PIECE(^AMHREC(AMHR,0),U,8)

 +3       ;record info

           SET DA=AMHR

           SET DDSFILE=9002011

           SET DR="[AMHVT ADD RECORD]"

           DO ^DDS

 +4        IF $DATA(DIMSG)

               WRITE !!,"ERROR IN SCREENMAN FORM!!"

               SET AMHQUIT=1

               KILL DIMSG

               QUIT 

 +5       ;check here for required items

 +6        SET AMHERROR=0

 +7        SET AMHREC=^AMHREC(AMHR,0)

 +8        IF $PIECE(AMHREC,U,4)=""

               WRITE !,"Location of Encounter Missing!"

               SET (AMHOKAY,AMHERROR)=1

 +9        IF $PIECE(AMHREC,U,5)=""

               WRITE !,"Community of Service Missing!"

               SET (AMHOKAY,AMHERROR)=1

 +10       IF $PIECE(AMHREC,U,6)=""

               WRITE !,"Activity Type Missing!"

               SET (AMHOKAY,AMHERROR)=1

 +11       IF $PIECE(AMHREC,U,7)=""

               WRITE !,"Type of Contact Missing!"

               SET (AMHOKAY,AMHERROR)=1

 +12       SET (X,Y)=0

           FOR 

               SET X=$ORDER(^AMHRPROV("AD",AMHR,X))

               IF X'=+X

                   QUIT 

               IF $PIECE(^AMHRPROV(X,0),U,4)="P"

                   SET Y=Y+1

 +13       IF Y=0

               WRITE !,"No primary Provider!",$CHAR(7),$CHAR(7)

               SET AMHERROR=1

               HANG 2

 +14       IF Y>1

               WRITE !,"Multiple Primary Providers!",$CHAR(7),$CHAR(7)

               IF '$GET(AMHERROR)

                   WRITE " PLEASE EDIT THIS RECORD"

               HANG 2

 +15       IF AMHERROR=1

               QUIT 

I1        ;S DA=AMHR,DDSFILE=9002011,DR="[AMH INTAKE POVS]" D ^DDS ;pov and other info collection

 +1       ;I $D(DIMSG) W !!,"ERROR IN SCREENMAN FORM!!" S AMHQUIT=1 K DIMSG Q

 +2        IF '$DATA(^AMHRPRO("AD",AMHR))

               WRITE !!,"At least one POV IS REQUIRED.  Please add one.",!

               HANG 2

               GOTO SAN1

 +3       ;INTAKE DATA COLLECTION

           DO EP1^AMHLESAN(AMHPAT,AMHR)

TP        ;

 +1        QUIT