ACMADDR.m

ACMADDR ; IHS/TUCSON/TMJ - PRINT PATIENT ADDRESS FOR CMS APPOINTMENT LETTER ;

 ;;2.0;ACM CASE MANAGEMENT SYSTEM;;JAN 10, 1996

EN D EN1

EXIT K ACM,ACMCOL,ACMLINE,ACMPTDFN,ACMPTNAM,ACMCONT

 W:$D(IOF) @IOF

 Q

EN1 S ACMPTDFN=$P(^ACM(49,D0,0),U,2),ACMCONT=$P(^ACM(41,$P(^(0),U,3),"DT"),U,13)

 Q:'$D(^DPT(ACMPTDFN,0))!'$D(^(.11))!(ACMLETR="")!($P(ACMLETR,U,1)="")!($P(ACMLETR,U,2)="")

 S ACMCOL=$P(ACMLETR,U,2),ACMLINE=$P(ACMLETR,U)

 F ACM=1:1:(ACMLINE-$Y) W !

 I ACMCONT'="" W !?ACMCOL,ACMCONT

 E  S ACMPTNAM=$P(^DPT(ACMPTDFN,0),U) W !?ACMCOL,$P($P(ACMPTNAM,",",2)," ")," ",$P(ACMPTNAM,",")

 W !?ACMCOL,$P(^DPT(ACMPTDFN,.11),U),!?ACMCOL,$P(^(.11),U,4),", ",$P(^DIC(5,$P(^(.11),U,5),0),U,2),"  ",$P(^DPT(ACMPTDFN,.11),U,6)

 K ACMPTDFN

 Q

ACMADDR   ; IHS/TUCSON/TMJ - PRINT PATIENT ADDRESS FOR CMS APPOINTMENT LETTER ;

 +1       ;;2.0;ACM CASE MANAGEMENT SYSTEM;;JAN 10, 1996

EN         DO EN1

EXIT       KILL ACM,ACMCOL,ACMLINE,ACMPTDFN,ACMPTNAM,ACMCONT

 +1        IF $DATA(IOF)

               WRITE @IOF

 +2        QUIT 

EN1        SET ACMPTDFN=$PIECE(^ACM(49,D0,0),U,2)

           SET ACMCONT=$PIECE(^ACM(41,$PIECE(^(0),U,3),"DT"),U,13)

 +1        IF '$DATA(^DPT(ACMPTDFN,0))!'$DATA(^(.11))!(ACMLETR="")!($PIECE(ACMLETR,U,1)="")!($PIECE(ACMLETR,U,2)="")

               QUIT 

 +2        SET ACMCOL=$PIECE(ACMLETR,U,2)

           SET ACMLINE=$PIECE(ACMLETR,U)

 +3        FOR ACM=1:1:(ACMLINE-$Y)

               WRITE !

 +4        IF ACMCONT'=""

               WRITE !?ACMCOL,ACMCONT

 +5       IF '$TEST

               SET ACMPTNAM=$PIECE(^DPT(ACMPTDFN,0),U)

               WRITE !?ACMCOL,$PIECE($PIECE(ACMPTNAM,",",2)," ")," ",$PIECE(ACMPTNAM,",")

 +6        WRITE !?ACMCOL,$PIECE(^DPT(ACMPTDFN,.11),U),!?ACMCOL,$PIECE(^(.11),U,4),", ",$PIECE(^DIC(5,$PIECE(^(.11),U,5),0),U,2),"  ",$PIECE(^DPT(ACMPTDFN,.11),U,6)

 +7        KILL ACMPTDFN

 +8        QUIT