QACNEWSV.m

QACNEWSV ;WCIOFO/ERC-Enter a new Service/Discipline ;9/13/97

 ;;2.0;Patient Representative;**3,5,12**;07/25/1995

 ;This routine allows Patient Advocates to make new entries in the

 ;Service/Discipline file (#745.55)

 S DIC="^QA(745.55,"

 S DIC(0)="AEL"

 S DIC("A")="Enter a new Service/Discipline: "

 S DLAYGO=745.55

 D ^DIC

 K DLAYGO

 Q:$G(Y)<0

 S DIE=DIC,DR=".01;1;2;3"

 S (DA,QACDA)=+Y

 D ^DIE

 ; if user does not enter a Discipline, display a message and give 

 ; another chance

 I $P(^QA(745.55,QACDA,0),U,3)']"" D

 . W !!?5,"Service/Discipline must point to a Discipline.",!

 . S DR="2;3" D ^DIE

 ; if still no discipline display a message & delete Service/Discipline

 I $P(^QA(745.55,QACDA,0),U,3)']"" D

 . W !!?5,"No Discipline entered - deleting Service/Discipline.",!

 . S DIK=DIE,DA=QACDA D ^DIK

 K DA,DIC,DIE,DR,QACDA

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---QACNEWSV   858     printed  Jan 14, 2021@17:15:39                                                                                                                                                                                                     Page 2

QACNEWSV  ;WCIOFO/ERC-Enter a new Service/Discipline ;9/13/97

 +1       ;;2.0;Patient Representative;**3,5,12**;07/25/1995

 +2       ;This routine allows Patient Advocates to make new entries in the

 +3       ;Service/Discipline file (#745.55)

 +4        SET DIC="^QA(745.55,"

 +5        SET DIC(0)="AEL"

 +6        SET DIC("A")="Enter a new Service/Discipline: "

 +7        SET DLAYGO=745.55

 +8        DO ^DIC

 +9        KILL DLAYGO

 +10       if $GET(Y)<0

               QUIT 

 +11       SET DIE=DIC

           SET DR=".01;1;2;3"

 +12       SET (DA,QACDA)=+Y

 +13       DO ^DIE

 +14      ; if user does not enter a Discipline, display a message and give 

 +15      ; another chance

 +16       IF $PIECE(^QA(745.55,QACDA,0),U,3)']""

               Begin DoDot:1

 +17               WRITE !!?5,"Service/Discipline must point to a Discipline.",!

 +18               SET DR="2;3"

                   DO ^DIE

               End DoDot:1

 +19      ; if still no discipline display a message & delete Service/Discipline

 +20       IF $PIECE(^QA(745.55,QACDA,0),U,3)']""

               Begin DoDot:1

 +21               WRITE !!?5,"No Discipline entered - deleting Service/Discipline.",!

 +22               SET DIK=DIE

                   SET DA=QACDA

                   DO ^DIK

               End DoDot:1

 +23       KILL DA,DIC,DIE,DR,QACDA

 +24       QUIT