APCDEFG.m

APCDEFG ; IHS/CMI/LAB -VISIT EDIT DISPLAY ;

 ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 ;IHS/AMNC/LJF

 ; -- this is a modified copy of APCDVD

 ; -- modified to select item from display to edit

EP(APCDVIEN,APCDARRY) ;EP

 ;

 I $G(APCDARRY)="" S APCDARRY="^TMP(""APCDEFG"",$J)"

 Q:'$D(APCDVIEN)

 Q:'APCDVIEN

 Q:'$D(^AUPNVSIT(APCDVIEN,0))

 D BUILD

 D XIT

 Q

 ;

SETF ;set file # in ^TMP

 S @APCDARRY@("MNE",APCDNUM)=MN

 Q

SET(X) ;set array

 S APCDCTR=APCDCTR+1

 S @APCDARRY@(APCDCTR,0)=APCDSTR

 S @APCDARRY@("IDX",APCDCTR,$S(APCDNUM>0:APCDNUM,1:1))=$G(X)

 S APCDSTR=""

 Q

BUILD ; build array

 K APCDAR

 D TERM^VALM0

 S APCDVREC=^AUPNVSIT(APCDVIEN,0)

 S Y=$P(APCDVREC,U,5) D ^AUPNPAT

 S APCDSTR="",APCDCTR=0,APCDNUM=0

 S APCDH="Patient Name",APCDV=IOINHI_$E($P(^DPT($P(APCDVREC,U,5),0),U),1,20)_IOINORM D BUILD1

 S APCDH="Chart #",APCDV=IOINHI_$S($D(^AUPNPAT($P(APCDVREC,U,5),41,DUZ(2),0)):$P(^(0),U,2),1:"None")_IOINORM D BUILD1

 S APCDH="Date of Birth" S Y=AUPNDOB D DD^%DT S APCDV=Y D BUILD1

 S APCDH="Sex",APCDV=AUPNSEX D BUILD1

 S APCDSTR="" D SET("")

VISIT ;

 ;S APCDSTR="=============== "_IOINHI_"VISIT FILE"_IOINORM_" ===============",X=(80-$L(APCDSTR)\2) D SET ;$J("",X)_APCDSTR D SET

 NEW MN S MN=$O(^APCDTKW("F",9000010,0)),APCDNUM=APCDNUM+1

 S APCDSTR=" <"_IOINHI_(APCDNUM)_IOINORM_"> ============= "_IOINHI_"VISIT FILE"_IOINORM_" ===============",X=(80-$L(APCDSTR)\2) D SET(""),SETF ;$J("",X)_APCDSTR D SET("")

 D ENP^XBDIQ1(9000010,APCDVIEN,".01:1500;1502:999999","APCDAR(","E")

 S F=0 F  S F=$O(APCDAR(F)) Q:F'=+F  I APCDAR(F)]"" D

 .S APCDH=$P(^DD(9000010,F,0),U)

 .S APCDV=APCDAR(F)

 .D BUILD1

 S APCDSTR="" D SET("")

 Q:'$P(APCDVREC,U,9)

VFILES ;set up array of all v file entries

 NEW DA,D0,DIC,DIQ,DR,DI

 S APCDVFLE=9000010 F  S APCDVFLE=$O(^DIC(APCDVFLE)) Q:APCDVFLE>9000010.99!(APCDVFLE'=+APCDVFLE)  D VF2

 D XIT

 Q

 ;

VF2 ;

 S APCDVNM=$P(^DIC(APCDVFLE,0),U),APCDVDG=^DIC(APCDVFLE,0,"GL"),APCDVIGR=APCDVDG_"""AD"",APCDVIEN,APCDVDFN)",APCDVDFN=""

 I $O(@APCDVIGR) S APCDNUM=APCDNUM+1

 F APCDVI=1:1 S APCDVDFN=$O(@APCDVIGR) Q:APCDVDFN=""  D VF3

 Q

 ;

VF3 ;

 ;I APCDVI<2 S APCDSTR="" D SET S APCDSTR="=============== "_IOINHI_$P(APCDVNM,"V ",2)_"s"_IOINORM_" ===============",X=(80-$L(APCDSTR)\2) D SET ;$J("",X)_APCDSTR D SET

 NEW MN S MN=$O(^APCDTKW("F",APCDVFLE,0))

 I APCDVI<2 S APCDSTR="" D SET("") S APCDSTR=" <"_IOINHI_(APCDNUM)_IOINORM_"> =============== "_IOINHI_$P(APCDVNM,"V ",2)_"s"_IOINORM_" ===============",X=(80-$L(APCDSTR)\2) D SET(""),SETF ;$J("",X)_APCDSTR D SET("")

 K APCDAR D ENP^XBDIQ1(APCDVFLE,APCDVDFN,".01:.019999;.04:999999","APCDAR(","E")

 I APCDVI>1 S APCDSTR="" D SET("")

 S F=0 F  S F=$O(APCDAR(F)) Q:F'=+F  D

 .I $G(APCDAR(F))]"" D  Q

 ..S APCDH=$P(^DD(APCDVFLE,F,0),U)

 ..S APCDV=APCDAR(F)

 ..D BUILD1

 .I $O(APCDAR(F,0)) D

 ..S APCDNARR=""

 ..S F1=0 F  S F1=$O(APCDAR(F,F1)) Q:F1'=+F1  D

 ...S APCDV=APCDAR(F,F1)

 ...D BUILD1

 ..K APCDNARR

 Q

 Q

BUILD1 ;

 I $D(APCDNARR) S APCDSTR="",APCDSTR=$$SETSTR^VALM1(APCDV,APCDSTR,1,$L(APCDV)) D SET("") Q

 S APCDSTR=$E(APCDH,1,21)_":",APCDSTR=$$SETSTR^VALM1(APCDV,APCDSTR,24,$L(APCDV))

 D SET("")

 Q

XIT ;

 K APCDAR,APCDARRY,APCDCTR,APCDH,APCDSTR,APCDV,APCDVDFN,APCDVDG,APCDVFLE,APCDVI,APCDVIEN,APCDVIGR,APCDFL,APCDVNM,APCDVREC,APCDH

 K DO,D0,DA,DI,DIC,DIQ,DR,F,X,Y,Z

 Q

 ;

 ;

APCDEFG   ; IHS/CMI/LAB -VISIT EDIT DISPLAY ;

 +1       ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 +2       ;IHS/AMNC/LJF

 +3       ; -- this is a modified copy of APCDVD

 +4       ; -- modified to select item from display to edit

EP(APCDVIEN,APCDARRY) ;EP

 +1       ;

 +2        IF $GET(APCDARRY)=""

               SET APCDARRY="^TMP(""APCDEFG"",$J)"

 +3        IF '$DATA(APCDVIEN)

               QUIT 

 +4        IF 'APCDVIEN

               QUIT 

 +5        IF '$DATA(^AUPNVSIT(APCDVIEN,0))

               QUIT 

 +6        DO BUILD

 +7        DO XIT

 +8        QUIT 

 +9       ;

SETF      ;set file # in ^TMP

 +1        SET @APCDARRY@("MNE",APCDNUM)=MN

 +2        QUIT 

SET(X)    ;set array

 +1        SET APCDCTR=APCDCTR+1

 +2        SET @APCDARRY@(APCDCTR,0)=APCDSTR

 +3        SET @APCDARRY@("IDX",APCDCTR,$SELECT(APCDNUM>0:APCDNUM,1:1))=$GET(X)

 +4        SET APCDSTR=""

 +5        QUIT 

BUILD     ; build array

 +1        KILL APCDAR

 +2        DO TERM^VALM0

 +3        SET APCDVREC=^AUPNVSIT(APCDVIEN,0)

 +4        SET Y=$PIECE(APCDVREC,U,5)

           DO ^AUPNPAT

 +5        SET APCDSTR=""

           SET APCDCTR=0

           SET APCDNUM=0

 +6        SET APCDH="Patient Name"

           SET APCDV=IOINHI_$EXTRACT($PIECE(^DPT($PIECE(APCDVREC,U,5),0),U),1,20)_IOINORM

           DO BUILD1

 +7        SET APCDH="Chart #"

           SET APCDV=IOINHI_$SELECT($DATA(^AUPNPAT($PIECE(APCDVREC,U,5),41,DUZ(2),0)):$PIECE(^(0),U,2),1:"None")_IOINORM

           DO BUILD1

 +8        SET APCDH="Date of Birth"

           SET Y=AUPNDOB

           DO DD^%DT

           SET APCDV=Y

           DO BUILD1

 +9        SET APCDH="Sex"

           SET APCDV=AUPNSEX

           DO BUILD1

 +10       SET APCDSTR=""

           DO SET("")

VISIT     ;

 +1       ;S APCDSTR="=============== "_IOINHI_"VISIT FILE"_IOINORM_" ===============",X=(80-$L(APCDSTR)\2) D SET ;$J("",X)_APCDSTR D SET

 +2        NEW MN

           SET MN=$ORDER(^APCDTKW("F",9000010,0))

           SET APCDNUM=APCDNUM+1

 +3       ;$J("",X)_APCDSTR D SET("")

           SET APCDSTR=" <"_IOINHI_(APCDNUM)_IOINORM_"> ============= "_IOINHI_"VISIT FILE"_IOINORM_" ==============="

           SET X=(80-$LENGTH(APCDSTR)\2)

           DO SET("")

           DO SETF

 +4        DO ENP^XBDIQ1(9000010,APCDVIEN,".01:1500;1502:999999","APCDAR(","E")

 +5        SET F=0

           FOR 

               SET F=$ORDER(APCDAR(F))

               IF F'=+F

                   QUIT 

               IF APCDAR(F)]""

                   Begin DoDot:1

 +6                    SET APCDH=$PIECE(^DD(9000010,F,0),U)

 +7                    SET APCDV=APCDAR(F)

 +8                    DO BUILD1

                   End DoDot:1

 +9        SET APCDSTR=""

           DO SET("")

 +10       IF '$PIECE(APCDVREC,U,9)

               QUIT 

VFILES    ;set up array of all v file entries

 +1        NEW DA,D0,DIC,DIQ,DR,DI

 +2        SET APCDVFLE=9000010

           FOR 

               SET APCDVFLE=$ORDER(^DIC(APCDVFLE))

               IF APCDVFLE>9000010.99!(APCDVFLE'=+APCDVFLE)

                   QUIT 

               DO VF2

 +3        DO XIT

 +4        QUIT 

 +5       ;

VF2       ;

 +1        SET APCDVNM=$PIECE(^DIC(APCDVFLE,0),U)

           SET APCDVDG=^DIC(APCDVFLE,0,"GL")

           SET APCDVIGR=APCDVDG_"""AD"",APCDVIEN,APCDVDFN)"

           SET APCDVDFN=""

 +2        IF $ORDER(@APCDVIGR)

               SET APCDNUM=APCDNUM+1

 +3        FOR APCDVI=1:1

               SET APCDVDFN=$ORDER(@APCDVIGR)

               IF APCDVDFN=""

                   QUIT 

               DO VF3

 +4        QUIT 

 +5       ;

VF3       ;

 +1       ;I APCDVI<2 S APCDSTR="" D SET S APCDSTR="=============== "_IOINHI_$P(APCDVNM,"V ",2)_"s"_IOINORM_" ===============",X=(80-$L(APCDSTR)\2) D SET ;$J("",X)_APCDSTR D SET

 +2        NEW MN

           SET MN=$ORDER(^APCDTKW("F",APCDVFLE,0))

 +3       ;$J("",X)_APCDSTR D SET("")

           IF APCDVI<2

               SET APCDSTR=""

               DO SET("")

               SET APCDSTR=" <"_IOINHI_(APCDNUM)_IOINORM_"> =============== "_IOINHI_$PIECE(APCDVNM,"V ",2)_"s"_IOINORM_" ==============="

               SET X=(80-$LENGTH(APCDSTR)\2)

               DO SET("")

               DO SETF

 +4        KILL APCDAR

           DO ENP^XBDIQ1(APCDVFLE,APCDVDFN,".01:.019999;.04:999999","APCDAR(","E")

 +5        IF APCDVI>1

               SET APCDSTR=""

               DO SET("")

 +6        SET F=0

           FOR 

               SET F=$ORDER(APCDAR(F))

               IF F'=+F

                   QUIT 

               Begin DoDot:1

 +7                IF $GET(APCDAR(F))]""

                       Begin DoDot:2

 +8                        SET APCDH=$PIECE(^DD(APCDVFLE,F,0),U)

 +9                        SET APCDV=APCDAR(F)

 +10                       DO BUILD1

                       End DoDot:2

                       QUIT 

 +11               IF $ORDER(APCDAR(F,0))

                       Begin DoDot:2

 +12                       SET APCDNARR=""

 +13                       SET F1=0

                           FOR 

                               SET F1=$ORDER(APCDAR(F,F1))

                               IF F1'=+F1

                                   QUIT 

                               Begin DoDot:3

 +14                               SET APCDV=APCDAR(F,F1)

 +15                               DO BUILD1

                               End DoDot:3

 +16                       KILL APCDNARR

                       End DoDot:2

               End DoDot:1

 +17       QUIT 

 +18       QUIT 

BUILD1    ;

 +1        IF $DATA(APCDNARR)

               SET APCDSTR=""

               SET APCDSTR=$$SETSTR^VALM1(APCDV,APCDSTR,1,$LENGTH(APCDV))

               DO SET("")

               QUIT 

 +2        SET APCDSTR=$EXTRACT(APCDH,1,21)_":"

           SET APCDSTR=$$SETSTR^VALM1(APCDV,APCDSTR,24,$LENGTH(APCDV))

 +3        DO SET("")

 +4        QUIT 

XIT       ;

 +1        KILL APCDAR,APCDARRY,APCDCTR,APCDH,APCDSTR,APCDV,APCDVDFN,APCDVDG,APCDVFLE,APCDVI,APCDVIEN,APCDVIGR,APCDFL,APCDVNM,APCDVREC,APCDH

 +2        KILL DO,D0,DA,DI,DIC,DIQ,DR,F,X,Y,Z

 +3        QUIT 

 +4       ;

 +5       ;