AMHPEDIT.m

AMHPEDIT ; IHS/CMI/LAB - INPUT TX ON PATIENT FIELD OF BH RECORD ;

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

 ;

 ;

 Q:'$D(AMHDATE)

 I AUPNDOD,$P(AMHDATE,".")>AUPNDOD W !,"  <Patient died before the visit date: DOD is "_$$FMTE^XLFDT(AUPNDOD)_">" Q

 I $P(AMHDATE,".")<AUPNDOB W !,"  <Patient born after the record date>" K X Q

 Q

 ;

 ;

DODGP(P,D) ;EP - called from screenman

 ;

 Q

 I $G(P)="" Q

 NEW T

 K T

 I $$DOD^AUPNPAT(P),$P(D,".")>$$DOD^AUPNPAT(P) D

 .S T(1)="  <Patient died before the visit date: DOD is "_$$FMTE^XLFDT($$DOD^AUPNPAT(P))_">"

 .S T(2)="  If you do not want to create a visit for this patient, please remove"

 .S T(3)="  them from the list by using the '@' to delete them."

 .D HLP^DDSUTL(.T)

 Q

PTSECG ;EP - called from screenman

 I '$D(X) Q

 NEW AMHRESU,HLP,C,J

 S C=0

 D PTSEC^AMHUTIL2(.AMHRESU,X,1)

 I '$G(AMHRESU(1)) Q

 I $G(AMHRESU(1))=3!($G(AMHRESU(1))=4)!($G(AMHRESU(1))=5) D  Q

 .S J=1 F  S J=$O(AMHRESU(J)) Q:J'=+J  D EN^DDIOL($$CTR(AMHRESU(J)))

 .K X

 S J=1 F  S J=$O(AMHRESU(J)) Q:J'=+J  D EN^DDIOL($$CTR(AMHRESU(J)))

 D EN^DDIOL("If you don't want to access this patient, delete them from the group")

 D EN^DDIOL("using the @")

 Q

CTR(X,Y) ;EP - Center X in a field Y wide.

 Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X

 ;----------

AMHPEDIT  ; IHS/CMI/LAB - INPUT TX ON PATIENT FIELD OF BH RECORD ;

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

 +2       ;

 +3       ;

 +4        IF '$DATA(AMHDATE)

               QUIT 

 +5        IF AUPNDOD

               IF $PIECE(AMHDATE,".")>AUPNDOD

                   WRITE !,"  <Patient died before the visit date: DOD is "_$$FMTE^XLFDT(AUPNDOD)_">"

                   QUIT 

 +6        IF $PIECE(AMHDATE,".")<AUPNDOB

               WRITE !,"  <Patient born after the record date>"

               KILL X

               QUIT 

 +7        QUIT 

 +8       ;

 +9       ;

DODGP(P,D) ;EP - called from screenman

 +1       ;

 +2        QUIT 

 +3        IF $GET(P)=""

               QUIT 

 +4        NEW T

 +5        KILL T

 +6        IF $$DOD^AUPNPAT(P)

               IF $PIECE(D,".")>$$DOD^AUPNPAT(P)

                   Begin DoDot:1

 +7                    SET T(1)="  <Patient died before the visit date: DOD is "_$$FMTE^XLFDT($$DOD^AUPNPAT(P))_">"

 +8                    SET T(2)="  If you do not want to create a visit for this patient, please remove"

 +9                    SET T(3)="  them from the list by using the '@' to delete them."

 +10                   DO HLP^DDSUTL(.T)

                   End DoDot:1

 +11       QUIT 

PTSECG    ;EP - called from screenman

 +1        IF '$DATA(X)

               QUIT 

 +2        NEW AMHRESU,HLP,C,J

 +3        SET C=0

 +4        DO PTSEC^AMHUTIL2(.AMHRESU,X,1)

 +5        IF '$GET(AMHRESU(1))

               QUIT 

 +6        IF $GET(AMHRESU(1))=3!($GET(AMHRESU(1))=4)!($GET(AMHRESU(1))=5)

               Begin DoDot:1

 +7                SET J=1

                   FOR 

                       SET J=$ORDER(AMHRESU(J))

                       IF J'=+J

                           QUIT 

                       DO EN^DDIOL($$CTR(AMHRESU(J)))

 +8                KILL X

               End DoDot:1

               QUIT 

 +9        SET J=1

           FOR 

               SET J=$ORDER(AMHRESU(J))

               IF J'=+J

                   QUIT 

               DO EN^DDIOL($$CTR(AMHRESU(J)))

 +10       DO EN^DDIOL("If you don't want to access this patient, delete them from the group")

 +11       DO EN^DDIOL("using the @")

 +12       QUIT 

CTR(X,Y)  ;EP - Center X in a field Y wide.

 +1        QUIT $JUSTIFY("",$SELECT($DATA(Y):Y,1:IOM)-$LENGTH(X)\2)_X

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