BIPATCO1.m

BIPATCO1 ;IHS/CMI/MWR - BUILD LIST ARRAY OF CONTRAS; MAY 10, 2010

 ;;8.5;IMMUNIZATION;;SEP 01,2011

 ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *

 ;;  BUILD LISTMANAGER ARRAY FOR DISPLAY AND EDIT OF

 ;;  PATIENT'S CONTRAINDICATIONS.

 ;

 ;

 ;----------

INIT ;EP

 ;---> Initialize variables and list array.

 ;

 S VALMSG="Enter ?? for more actions."

 ;

 ;---> If BIDFN not supplied, set Error Code and quit.

 I '$G(BIDFN) D ERRCD^BIUTL2(201,,1) Q

 ;

 ;---> Initialize RPC variables.

 ;     BI31     - Delimiter between return value and return error.

 ;     BIRETVAL - Return value of valid data from RPC.

 ;     BIRETERR - Return value (text string) of error from RPC.

 ;

 N BI31,BIRETVAL,BIRETERR

 S BI31=$C(31)_$C(31),BIRETVAL=""

 ;

 ;---> RPC to gather Contraindications History.

 D CONTRAS^BIRPC5(.BIRETVAL,BIDFN)

 ;

 ;---> If BIRETERR has a value, display it and quit.

 S BIRETERR=$P(BIRETVAL,BI31,2)

 I BIRETERR]"" D EN^DDIOL("* "_BIRETERR,"","!!?5"),DIRZ^BIUTL3() Q

 ;

 ;---> Set BICONT=to a string of Contraindications for this patient.

 ;---> * NOTE! BICONT(BIDFN) is not newed; it is used to edit and delete

 ;       Immunizations for this patient (sub BIDFN for insurance).

 ;

 K BICONT(BIDFN)

 S BICONT(BIDFN)=$P(BIRETVAL,BI31,1)

 ;

 ;---> Build Listmanager array from BICONT(BIDFN) string.

 K ^TMP("BILMCO",$J)

 N BIENT,BILINE,I,V,X,Y,Z

 S BIENT=0,BILINE=0,V="|",Z=""

 ;

 ;---> Insert blank line at the top of the List Region.

 S ^TMP("BILMCO",$J,1,0)=""

 S ^TMP("BILMCO",$J,"IDX",1,1)=""

 ;

 ;---> Build Listmanager array from BICONT string.

 ;

 F I=1:1 S Y=$P(BICONT(BIDFN),U,I) Q:Y=""  D

 .;---> Build display line for this Contraindication.

 .S X="    "_I_"  "

 .S X=X_$P(Y,V,2)_":",X=$$PAD^BIUTL5(X,19)_$P(Y,V,3)

 .S X=$$PAD^BIUTL5(X,47)_$P(Y,V,4)

 .;

 .;---> Set formatted Contraindication line and index in ^TMP.

 .S ^TMP("BILMCO",$J,I+1,0)=X

 .S ^TMP("BILMCO",$J,"IDX",I+1,I)=""

 ;

 ;---> Finish up Listmanager List Count.

 S VALMCNT=I

 I VALMCNT>12 D

 .S VALMSG="Scroll down to view more. Type ?? for more actions."

 Q

BIPATCO1  ;IHS/CMI/MWR - BUILD LIST ARRAY OF CONTRAS; MAY 10, 2010

 +1       ;;8.5;IMMUNIZATION;;SEP 01,2011

 +2       ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *

 +3       ;;  BUILD LISTMANAGER ARRAY FOR DISPLAY AND EDIT OF

 +4       ;;  PATIENT'S CONTRAINDICATIONS.

 +5       ;

 +6       ;

 +7       ;----------

INIT      ;EP

 +1       ;---> Initialize variables and list array.

 +2       ;

 +3        SET VALMSG="Enter ?? for more actions."

 +4       ;

 +5       ;---> If BIDFN not supplied, set Error Code and quit.

 +6        IF '$GET(BIDFN)

               DO ERRCD^BIUTL2(201,,1)

               QUIT 

 +7       ;

 +8       ;---> Initialize RPC variables.

 +9       ;     BI31     - Delimiter between return value and return error.

 +10      ;     BIRETVAL - Return value of valid data from RPC.

 +11      ;     BIRETERR - Return value (text string) of error from RPC.

 +12      ;

 +13       NEW BI31,BIRETVAL,BIRETERR

 +14       SET BI31=$CHAR(31)_$CHAR(31)

           SET BIRETVAL=""

 +15      ;

 +16      ;---> RPC to gather Contraindications History.

 +17       DO CONTRAS^BIRPC5(.BIRETVAL,BIDFN)

 +18      ;

 +19      ;---> If BIRETERR has a value, display it and quit.

 +20       SET BIRETERR=$PIECE(BIRETVAL,BI31,2)

 +21       IF BIRETERR]""

               DO EN^DDIOL("* "_BIRETERR,"","!!?5")

               DO DIRZ^BIUTL3()

               QUIT 

 +22      ;

 +23      ;---> Set BICONT=to a string of Contraindications for this patient.

 +24      ;---> * NOTE! BICONT(BIDFN) is not newed; it is used to edit and delete

 +25      ;       Immunizations for this patient (sub BIDFN for insurance).

 +26      ;

 +27       KILL BICONT(BIDFN)

 +28       SET BICONT(BIDFN)=$PIECE(BIRETVAL,BI31,1)

 +29      ;

 +30      ;---> Build Listmanager array from BICONT(BIDFN) string.

 +31       KILL ^TMP("BILMCO",$JOB)

 +32       NEW BIENT,BILINE,I,V,X,Y,Z

 +33       SET BIENT=0

           SET BILINE=0

           SET V="|"

           SET Z=""

 +34      ;

 +35      ;---> Insert blank line at the top of the List Region.

 +36       SET ^TMP("BILMCO",$JOB,1,0)=""

 +37       SET ^TMP("BILMCO",$JOB,"IDX",1,1)=""

 +38      ;

 +39      ;---> Build Listmanager array from BICONT string.

 +40      ;

 +41       FOR I=1:1

               SET Y=$PIECE(BICONT(BIDFN),U,I)

               IF Y=""

                   QUIT 

               Begin DoDot:1

 +42      ;---> Build display line for this Contraindication.

 +43               SET X="    "_I_"  "

 +44               SET X=X_$PIECE(Y,V,2)_":"

                   SET X=$$PAD^BIUTL5(X,19)_$PIECE(Y,V,3)

 +45               SET X=$$PAD^BIUTL5(X,47)_$PIECE(Y,V,4)

 +46      ;

 +47      ;---> Set formatted Contraindication line and index in ^TMP.

 +48               SET ^TMP("BILMCO",$JOB,I+1,0)=X

 +49               SET ^TMP("BILMCO",$JOB,"IDX",I+1,I)=""

               End DoDot:1

 +50      ;

 +51      ;---> Finish up Listmanager List Count.

 +52       SET VALMCNT=I

 +53       IF VALMCNT>12

               Begin DoDot:1

 +54               SET VALMSG="Scroll down to view more. Type ?? for more actions."

               End DoDot:1

 +55       QUIT