A1B2ADM.m

A1B2ADM ;ALB/MIR - Create ODS ADMISSION record from past admission record ;23 JAN 91

 ;;Version 1.55 (local for MAS v5 sites);;

 ;

 D ON^A1B2UTL I 'A1B2ODS W !,"ODS software is not on...you can not use this option" G Q

PAT ;ask patient, check if ODS

 W !! K DIC S DIC="^DPT(",DIC(0)="AEQMZ" D ^DIC G Q:Y'>0 S DFN=+Y

 I $S('$D(^DPT(DFN,.32)):1,'$D(^DIC(21,+$P(^(.32),"^",3),0)):1,$P(^(0),"^",3)'=6:1,1:0) W !!?5,"Patient does not have a period of service of ODS" G PAT

 S DIC("S")="I $P(^(0),""^"",2)=1,(^(0)>2910115),$S('$D(^(""ODS"")):1,'$P(^(""ODS""),""^"",4):1,1:0)" D EN^DGPMUTL S A1B2MVT=Y

 I Y'>0 G PAT

 ;

ASK W !!,"Do you want to create an ODS ADMISSION entry for " S Y=$P(Y,"^",2) X ^DD("DD") W Y S %=2 D YN^DICN I $D(DTOUT) G Q

 I %<0!(%=2) G PAT

 I '% W !?2,"Enter 'Y'es if this admission was for care related to Operation",!?2,"Desert Shield.  Otherwise, respond 'N'o." G ASK

ADD ;

 S DGPMDA=+A1B2MVT,DGPMA=$P(A1B2MVT,"^",2) D ADM^DGPMVODS

 S DIE="^DGPM(",DA=+A1B2MVT,DR="11500.01////1;11500.04////^S X=DGODSE" D ^DIE

 S A1B2Y=11500.2,X=+DGODSE D UPD^A1B2XFR

 W !,"Record Created"

Q K %,%Y,A1B2MVT,A1B2ODS,A1B2Y,DA,DFN,DGODSE,DGPMDA,DGPMA,DIC,DIE,DR,DTOUT,I,J,X,Y

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---A1B2ADM   1198     printed  Apr 09, 2024@21:24:09                                                                                                                                                                                                     Page 2

A1B2ADM   ;ALB/MIR - Create ODS ADMISSION record from past admission record ;23 JAN 91

 +1       ;;Version 1.55 (local for MAS v5 sites);;

 +2       ;

 +3        DO ON^A1B2UTL

           IF 'A1B2ODS

               WRITE !,"ODS software is not on...you can not use this option"

               GOTO Q

PAT       ;ask patient, check if ODS

 +1        WRITE !!

           KILL DIC

           SET DIC="^DPT("

           SET DIC(0)="AEQMZ"

           DO ^DIC

           if Y'>0

               GOTO Q

           SET DFN=+Y

 +2        IF $SELECT('$DATA(^DPT(DFN,.32)):1,'$DATA(^DIC(21,+$PIECE(^(.32),"^",3),0)):1,$PIECE(^(0),"^",3)'=6:1,1:0)

               WRITE !!?5,"Patient does not have a period of service of ODS"

               GOTO PAT

 +3        SET DIC("S")="I $P(^(0),""^"",2)=1,(^(0)>2910115),$S('$D(^(""ODS"")):1,'$P(^(""ODS""),""^"",4):1,1:0)"

           DO EN^DGPMUTL

           SET A1B2MVT=Y

 +4        IF Y'>0

               GOTO PAT

 +5       ;

ASK        WRITE !!,"Do you want to create an ODS ADMISSION entry for "

           SET Y=$PIECE(Y,"^",2)

           XECUTE ^DD("DD")

           WRITE Y

           SET %=2

           DO YN^DICN

           IF $DATA(DTOUT)

               GOTO Q

 +1        IF %<0!(%=2)

               GOTO PAT

 +2        IF '%

               WRITE !?2,"Enter 'Y'es if this admission was for care related to Operation",!?2,"Desert Shield.  Otherwise, respond 'N'o."

               GOTO ASK

ADD       ;

 +1        SET DGPMDA=+A1B2MVT

           SET DGPMA=$PIECE(A1B2MVT,"^",2)

           DO ADM^DGPMVODS

 +2        SET DIE="^DGPM("

           SET DA=+A1B2MVT

           SET DR="11500.01////1;11500.04////^S X=DGODSE"

           DO ^DIE

 +3        SET A1B2Y=11500.2

           SET X=+DGODSE

           DO UPD^A1B2XFR

 +4        WRITE !,"Record Created"

Q          KILL %,%Y,A1B2MVT,A1B2ODS,A1B2Y,DA,DFN,DGODSE,DGPMDA,DGPMA,DIC,DIE,DR,DTOUT,I,J,X,Y

 +1        QUIT