Routine: IBDEI010

IBDEI010	; ; 18-MAR-1994

	;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94

	Q:'DIFQR(358.5)  F I=1:2 S X=$T(Q+I) Q:X=""  S Y=$E($T(Q+I+1),4,999),X=$E(X,4,999) S:$A(Y)=126 I=I+1,Y=$E(Y,2,999)_$E($T(Q+I+1),5,99) S:$A(Y)=61 Y=$E(Y,2,999) X NO E  S @X=Y

Q	Q

	;;^UTILITY(U,$J,358.5,79,0)

	;;=EMPLOYMENT STATUS^14^19

	;;^UTILITY(U,$J,358.5,79,2,0)

	;;=^357.52I^1^1

	;;^UTILITY(U,$J,358.5,79,2,1,0)

	;;=Status:^^^20^12^12^28^20^1

	;;^UTILITY(U,$J,358.5,80,0)

	;;=SPOUSE'S EMPLOYER^14^20

	;;^UTILITY(U,$J,358.5,80,2,0)

	;;=^357.52I^1^1

	;;^UTILITY(U,$J,358.5,80,2,1,0)

	;;=Spouse's Employer:^^U^1^14^15^4^45^1

	;;^UTILITY(U,$J,358.5,81,0)

	;;=VITALS^15^3

	;;^UTILITY(U,$J,358.5,81,2,0)

	;;=^357.52I^6^5

	;;^UTILITY(U,$J,358.5,81,2,1,0)

	;;=WT:^^^15^1^1^19^14^1

	;;^UTILITY(U,$J,358.5,81,2,2,0)

	;;=BP:^^^37^1^1^41^14^1

	;;^UTILITY(U,$J,358.5,81,2,3,0)

	;;=T:^^^59^1^1^62^14^1

	;;^UTILITY(U,$J,358.5,81,2,4,0)

	;;=P:^^^15^3^3^19^14^1

	;;^UTILITY(U,$J,358.5,81,2,6,0)

	;;=INITIALS/TIME:^^^38^3^3^54^20^1

	;;^UTILITY(U,$J,358.5,82,0)

	;;=PROGRESS NOTES^16^2^^^Progress Notes:   (  ) Attached  (  ) See Chart^^^^0^0^24^2^87

	;;^UTILITY(U,$J,358.5,83,0)

	;;=SIGNATURE^16^3

	;;^UTILITY(U,$J,358.5,83,2,0)

	;;=^357.52I^1^1

	;;^UTILITY(U,$J,358.5,83,2,1,0)

	;;=Provider Signature^^^64^27^26^54^45^1

	;;^UTILITY(U,$J,358.5,84,0)

	;;=PATIENT NAME^19^6

	;;^UTILITY(U,$J,358.5,84,2,0)

	;;=^357.52I^1^1

	;;^UTILITY(U,$J,358.5,84,2,1,0)

	;;=Patient Name:^^^1^1^1^15^30^1

	;;^UTILITY(U,$J,358.5,85,0)

	;;=PATIENT DOB^19^22

	;;^UTILITY(U,$J,358.5,85,2,0)

	;;=^357.52I^1^1

	;;^UTILITY(U,$J,358.5,85,2,1,0)

	;;=DOB:^^^1^2^2^6^12^1

	;;^UTILITY(U,$J,358.5,86,0)

	;;=PID^19^7

	;;^UTILITY(U,$J,358.5,86,2,0)

	;;=^357.52I^1^1

	;;^UTILITY(U,$J,358.5,86,2,1,0)

	;;=PID:^^^19^2^2^24^15^1

	;;^UTILITY(U,$J,358.5,87,0)

	;;=SC CONDITION 1^19^11^^1

	;;^UTILITY(U,$J,358.5,87,2,0)

	;;=^357.52I^2^2

	;;^UTILITY(U,$J,358.5,87,2,1,0)

	;;=SC Conditions:^^U^1^4^5^1^40^1

	;;^UTILITY(U,$J,358.5,87,2,2,0)

	;;=%^^I^^^5^42^4^3

	;;^UTILITY(U,$J,358.5,88,0)

	;;=SC CONDITION 2^19^11^^2

	;;^UTILITY(U,$J,358.5,88,2,0)

	;;=^357.52I^2^2

	;;^UTILITY(U,$J,358.5,88,2,1,0)

	;;=CONDITION^^I^^^6^1^40^1

	;;^UTILITY(U,$J,358.5,88,2,2,0)

	;;=%^^I^^^6^42^4^3

	;;^UTILITY(U,$J,358.5,89,0)

	;;=SC CONDITION 3^19^11^^3

	;;^UTILITY(U,$J,358.5,89,2,0)

	;;=^357.52I^2^2

	;;^UTILITY(U,$J,358.5,89,2,1,0)

	;;=CONDITION^^I^^^7^1^40^1

	;;^UTILITY(U,$J,358.5,89,2,2,0)

	;;=%^^I^^^7^42^4^3

	;;^UTILITY(U,$J,358.5,90,0)

	;;=SC CONDITION 4^19^11^1^4

	;;^UTILITY(U,$J,358.5,90,2,0)

	;;=^357.52I^2^2

	;;^UTILITY(U,$J,358.5,90,2,1,0)

	;;=CONDITION^^I^^^8^1^40^1

	;;^UTILITY(U,$J,358.5,90,2,2,0)

	;;=%^^I^^^8^42^4^3

	;;^UTILITY(U,$J,358.5,91,0)

	;;=SEX^19^23

	;;^UTILITY(U,$J,358.5,91,2,0)

	;;=^357.52I^1^1

	;;^UTILITY(U,$J,358.5,91,2,1,0)

	;;=Sex:^^^40^2^2^45^1^2

	;;^UTILITY(U,$J,358.5,92,0)

	;;=ELIGIBILITY^19^8

	;;^UTILITY(U,$J,358.5,92,2,0)

	;;=^357.52I^1^1

	;;^UTILITY(U,$J,358.5,92,2,1,0)

	;;=Eligibility:^^^1^3^3^14^30^1

	;;^UTILITY(U,$J,358.5,93,0)

	;;=MEANS TEST CATEGORY^19^24

	;;^UTILITY(U,$J,358.5,93,2,0)

	;;=^357.52I^1^1

	;;^UTILITY(U,$J,358.5,93,2,1,0)

	;;=Means Test Cat:^^^29^4^4^45^1^3

	;;^UTILITY(U,$J,358.5,94,0)

	;;=SERVICE HISTORY DATA^19^25

	;;^UTILITY(U,$J,358.5,94,2,0)

	;;=^357.52I^4^4

	;;^UTILITY(U,$J,358.5,94,2,1,0)

	;;=AO:^^^1^9^9^5^3^2

	;;^UTILITY(U,$J,358.5,94,2,2,0)

	;;=IR:^^^9^9^9^13^3^3

	;;^UTILITY(U,$J,358.5,94,2,3,0)

	;;=POW:^^^17^9^9^22^3^4

	;;^UTILITY(U,$J,358.5,94,2,4,0)

	;;=EC:^^^26^9^9^30^3^6

	;;^UTILITY(U,$J,358.5,95,0)

	;;=SC %^19^8

	;;^UTILITY(U,$J,358.5,95,2,0)

	;;=^357.52I^3^2

	;;^UTILITY(U,$J,358.5,95,2,2,0)

	;;=SC%:^^^17^4^4^22^3^7

	;;^UTILITY(U,$J,358.5,95,2,3,0)

	;;=%^^^25^4

	;;^UTILITY(U,$J,358.5,96,0)

	;;=SC TREATMENT QUESTIONS^20^26

	;;^UTILITY(U,$J,358.5,96,2,0)

	;;=^357.52I^2^2

	;;^UTILITY(U,$J,358.5,96,2,1,0)

	;;=SERVICE CONNECTED?^^I^^^0^0^46^1

IBDEI010  ; ; 18-MAR-1994

 +1       ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94

 +2        IF 'DIFQR(358.5)

               QUIT

           FOR I=1:2

               SET X=$TEXT(Q+I)

               IF X=""

                   QUIT

               SET Y=$EXTRACT($TEXT(Q+I+1),4,999)

               SET X=$EXTRACT(X,4,999)

               IF $ASCII(Y)=126

                   SET I=I+1

                   SET Y=$EXTRACT(Y,2,999)_$EXTRACT($TEXT(Q+I+1),5,99)

               IF $ASCII(Y)=61

                   SET Y=$EXTRACT(Y,2,999)

               XECUTE NO

              IF '$TEST

                   SET @X=Y

Q          QUIT

 +1       ;;^UTILITY(U,$J,358.5,79,0)

 +2       ;;=EMPLOYMENT STATUS^14^19

 +3       ;;^UTILITY(U,$J,358.5,79,2,0)

 +4       ;;=^357.52I^1^1

 +5       ;;^UTILITY(U,$J,358.5,79,2,1,0)

 +6       ;;=Status:^^^20^12^12^28^20^1

 +7       ;;^UTILITY(U,$J,358.5,80,0)

 +8       ;;=SPOUSE'S EMPLOYER^14^20

 +9       ;;^UTILITY(U,$J,358.5,80,2,0)

 +10      ;;=^357.52I^1^1

 +11      ;;^UTILITY(U,$J,358.5,80,2,1,0)

 +12      ;;=Spouse's Employer:^^U^1^14^15^4^45^1

 +13      ;;^UTILITY(U,$J,358.5,81,0)

 +14      ;;=VITALS^15^3

 +15      ;;^UTILITY(U,$J,358.5,81,2,0)

 +16      ;;=^357.52I^6^5

 +17      ;;^UTILITY(U,$J,358.5,81,2,1,0)

 +18      ;;=WT:^^^15^1^1^19^14^1

 +19      ;;^UTILITY(U,$J,358.5,81,2,2,0)

 +20      ;;=BP:^^^37^1^1^41^14^1

 +21      ;;^UTILITY(U,$J,358.5,81,2,3,0)

 +22      ;;=T:^^^59^1^1^62^14^1

 +23      ;;^UTILITY(U,$J,358.5,81,2,4,0)

 +24      ;;=P:^^^15^3^3^19^14^1

 +25      ;;^UTILITY(U,$J,358.5,81,2,6,0)

 +26      ;;=INITIALS/TIME:^^^38^3^3^54^20^1

 +27      ;;^UTILITY(U,$J,358.5,82,0)

 +28      ;;=PROGRESS NOTES^16^2^^^Progress Notes:   (  ) Attached  (  ) See Chart^^^^0^0^24^2^87

 +29      ;;^UTILITY(U,$J,358.5,83,0)

 +30      ;;=SIGNATURE^16^3

 +31      ;;^UTILITY(U,$J,358.5,83,2,0)

 +32      ;;=^357.52I^1^1

 +33      ;;^UTILITY(U,$J,358.5,83,2,1,0)

 +34      ;;=Provider Signature^^^64^27^26^54^45^1

 +35      ;;^UTILITY(U,$J,358.5,84,0)

 +36      ;;=PATIENT NAME^19^6

 +37      ;;^UTILITY(U,$J,358.5,84,2,0)

 +38      ;;=^357.52I^1^1

 +39      ;;^UTILITY(U,$J,358.5,84,2,1,0)

 +40      ;;=Patient Name:^^^1^1^1^15^30^1

 +41      ;;^UTILITY(U,$J,358.5,85,0)

 +42      ;;=PATIENT DOB^19^22

 +43      ;;^UTILITY(U,$J,358.5,85,2,0)

 +44      ;;=^357.52I^1^1

 +45      ;;^UTILITY(U,$J,358.5,85,2,1,0)

 +46      ;;=DOB:^^^1^2^2^6^12^1

 +47      ;;^UTILITY(U,$J,358.5,86,0)

 +48      ;;=PID^19^7

 +49      ;;^UTILITY(U,$J,358.5,86,2,0)

 +50      ;;=^357.52I^1^1

 +51      ;;^UTILITY(U,$J,358.5,86,2,1,0)

 +52      ;;=PID:^^^19^2^2^24^15^1

 +53      ;;^UTILITY(U,$J,358.5,87,0)

 +54      ;;=SC CONDITION 1^19^11^^1

 +55      ;;^UTILITY(U,$J,358.5,87,2,0)

 +56      ;;=^357.52I^2^2

 +57      ;;^UTILITY(U,$J,358.5,87,2,1,0)

 +58      ;;=SC Conditions:^^U^1^4^5^1^40^1

 +59      ;;^UTILITY(U,$J,358.5,87,2,2,0)

 +60      ;;=%^^I^^^5^42^4^3

 +61      ;;^UTILITY(U,$J,358.5,88,0)

 +62      ;;=SC CONDITION 2^19^11^^2

 +63      ;;^UTILITY(U,$J,358.5,88,2,0)

 +64      ;;=^357.52I^2^2

 +65      ;;^UTILITY(U,$J,358.5,88,2,1,0)

 +66      ;;=CONDITION^^I^^^6^1^40^1

 +67      ;;^UTILITY(U,$J,358.5,88,2,2,0)

 +68      ;;=%^^I^^^6^42^4^3

 +69      ;;^UTILITY(U,$J,358.5,89,0)

 +70      ;;=SC CONDITION 3^19^11^^3

 +71      ;;^UTILITY(U,$J,358.5,89,2,0)

 +72      ;;=^357.52I^2^2

 +73      ;;^UTILITY(U,$J,358.5,89,2,1,0)

 +74      ;;=CONDITION^^I^^^7^1^40^1

 +75      ;;^UTILITY(U,$J,358.5,89,2,2,0)

 +76      ;;=%^^I^^^7^42^4^3

 +77      ;;^UTILITY(U,$J,358.5,90,0)

 +78      ;;=SC CONDITION 4^19^11^1^4

 +79      ;;^UTILITY(U,$J,358.5,90,2,0)

 +80      ;;=^357.52I^2^2

 +81      ;;^UTILITY(U,$J,358.5,90,2,1,0)

 +82      ;;=CONDITION^^I^^^8^1^40^1

 +83      ;;^UTILITY(U,$J,358.5,90,2,2,0)

 +84      ;;=%^^I^^^8^42^4^3

 +85      ;;^UTILITY(U,$J,358.5,91,0)

 +86      ;;=SEX^19^23

 +87      ;;^UTILITY(U,$J,358.5,91,2,0)

 +88      ;;=^357.52I^1^1

 +89      ;;^UTILITY(U,$J,358.5,91,2,1,0)

 +90      ;;=Sex:^^^40^2^2^45^1^2

 +91      ;;^UTILITY(U,$J,358.5,92,0)

 +92      ;;=ELIGIBILITY^19^8

 +93      ;;^UTILITY(U,$J,358.5,92,2,0)

 +94      ;;=^357.52I^1^1

 +95      ;;^UTILITY(U,$J,358.5,92,2,1,0)

 +96      ;;=Eligibility:^^^1^3^3^14^30^1

 +97      ;;^UTILITY(U,$J,358.5,93,0)

 +98      ;;=MEANS TEST CATEGORY^19^24

 +99      ;;^UTILITY(U,$J,358.5,93,2,0)

 +100     ;;=^357.52I^1^1

 +101     ;;^UTILITY(U,$J,358.5,93,2,1,0)

 +102     ;;=Means Test Cat:^^^29^4^4^45^1^3

 +103     ;;^UTILITY(U,$J,358.5,94,0)

 +104     ;;=SERVICE HISTORY DATA^19^25

 +105     ;;^UTILITY(U,$J,358.5,94,2,0)

 +106     ;;=^357.52I^4^4

 +107     ;;^UTILITY(U,$J,358.5,94,2,1,0)

 +108     ;;=AO:^^^1^9^9^5^3^2

 +109     ;;^UTILITY(U,$J,358.5,94,2,2,0)

 +110     ;;=IR:^^^9^9^9^13^3^3

 +111     ;;^UTILITY(U,$J,358.5,94,2,3,0)

 +112     ;;=POW:^^^17^9^9^22^3^4

 +113     ;;^UTILITY(U,$J,358.5,94,2,4,0)

 +114     ;;=EC:^^^26^9^9^30^3^6

 +115     ;;^UTILITY(U,$J,358.5,95,0)

 +116     ;;=SC %^19^8

 +117     ;;^UTILITY(U,$J,358.5,95,2,0)

 +118     ;;=^357.52I^3^2

 +119     ;;^UTILITY(U,$J,358.5,95,2,2,0)

 +120     ;;=SC%:^^^17^4^4^22^3^7

 +121     ;;^UTILITY(U,$J,358.5,95,2,3,0)

 +122     ;;=%^^^25^4

 +123     ;;^UTILITY(U,$J,358.5,96,0)

 +124     ;;=SC TREATMENT QUESTIONS^20^26

 +125     ;;^UTILITY(U,$J,358.5,96,2,0)

 +126     ;;=^357.52I^2^2

 +127     ;;^UTILITY(U,$J,358.5,96,2,1,0)

 +128     ;;=SERVICE CONNECTED?^^I^^^0^0^46^1

IBDEI010.m