AGED7A.m

AGED7A ; IHS/ASDS/EFG - PAGE 7 (cont) ;  

 ;;7.1;PATIENT REGISTRATION;;AUG 25,2005

 ;

ALPHORD ;

 D ^AGED

 W ! ;!,"POLICIES:",!

 S AG("CNAME")=" ",AG("CCTR")=0

 F  S AG("CNAME")=$O(AG("ALPHORD",AG("CNAME"))) Q:AG("CNAME")=""  D

 .S AG("INSDUP")=""

 .F AG("CTR2")=1:1 S AG("INSDUP")=$O(AG("ALPHORD",AG("CNAME"),AG("INSDUP"))) Q:'+AG("INSDUP")  S AG("CCTR")=AG("CCTR")+1 D

 ..S AG("ALPHORD",AG("CCTR"))=+AG("ALPHORD",AG("CNAME"),AG("INSDUP"))

 ..W !,$J(AG("CCTR"),2),". ",AG("CNAME")

 ..W ?35,$P(AG("ALPHORD",AG("CNAME"),AG("INSDUP")),U,3)

 ..W ?52,$P(AG("ALPHORD",AG("CNAME"),AG("INSDUP")),U,5)

 Q

AGED7A    ; IHS/ASDS/EFG - PAGE 7 (cont) ;  

 +1       ;;7.1;PATIENT REGISTRATION;;AUG 25,2005

 +2       ;

ALPHORD   ;

 +1        DO ^AGED

 +2       ;!,"POLICIES:",!

           WRITE !

 +3        SET AG("CNAME")=" "

           SET AG("CCTR")=0

 +4        FOR 

               SET AG("CNAME")=$ORDER(AG("ALPHORD",AG("CNAME")))

               IF AG("CNAME")=""

                   QUIT 

               Begin DoDot:1

 +5                SET AG("INSDUP")=""

 +6                FOR AG("CTR2")=1:1

                       SET AG("INSDUP")=$ORDER(AG("ALPHORD",AG("CNAME"),AG("INSDUP")))

                       IF '+AG("INSDUP")

                           QUIT 

                       SET AG("CCTR")=AG("CCTR")+1

                       Begin DoDot:2

 +7                        SET AG("ALPHORD",AG("CCTR"))=+AG("ALPHORD",AG("CNAME"),AG("INSDUP"))

 +8                        WRITE !,$JUSTIFY(AG("CCTR"),2),". ",AG("CNAME")

 +9                        WRITE ?35,$PIECE(AG("ALPHORD",AG("CNAME"),AG("INSDUP")),U,3)

 +10                       WRITE ?52,$PIECE(AG("ALPHORD",AG("CNAME"),AG("INSDUP")),U,5)

                       End DoDot:2

               End DoDot:1

 +11       QUIT