QACNOPTS.m

QACNOPTS ;HISC/VAD -Contact records without patients ;12/29/98  09:41

 ;;2.0;Patient Representative;**9,17**;11/17/1998

MAIN ;

 S QAQPOP=0

 D DATDIV^QACUTL0 G:QAQPOP EXIT

 K DIC,FLDS,L,BY,FR,TO,DHD

 S L=0,DIC="^QA(745.1,"

 S FLDS=".01,1",DHD="[QAC NOPAT HEADER]"

 ;

 K DIC,FLDS,L,BY,FR,TO,DHD

 S L=0,DIC="^QA(745.1,"

 S FLDS=".01,1",DHD="[QAC NOPAT HEADER]"

 S BY="37;S3;C25,'2,1"

 S FR(1)="@",TO(1)=""

 I +$G(QAC1DIV) D

 . S QACDVNAM="" D INST^QACUTL0(QAC1DIV,.QACDVNAM)

 . S (FR(1),TO(1))=QACDVNAM

 S FR(2)="@",TO(2)="@"

 S FR(3)=QAQNBEG,TO(3)=QAQNEND

 D EN1^DIP

EXIT ;

 K DIC,FLDS,L,BY,FR,TO,DHD,DIP,QACPOP,QACDV,QAC1DIV,QACDVNAM

 K QAQNBEG,QAQNEND,QAQPOP

 D K^QAQDATE

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---QACNOPTS   700     printed  Jan 14, 2021@17:15:33                                                                                                                                                                                                     Page 2

QACNOPTS  ;HISC/VAD -Contact records without patients ;12/29/98  09:41

 +1       ;;2.0;Patient Representative;**9,17**;11/17/1998

MAIN      ;

 +1        SET QAQPOP=0

 +2        DO DATDIV^QACUTL0

           if QAQPOP

               GOTO EXIT

 +3        KILL DIC,FLDS,L,BY,FR,TO,DHD

 +4        SET L=0

           SET DIC="^QA(745.1,"

 +5        SET FLDS=".01,1"

           SET DHD="[QAC NOPAT HEADER]"

 +6       ;

 +7        KILL DIC,FLDS,L,BY,FR,TO,DHD

 +8        SET L=0

           SET DIC="^QA(745.1,"

 +9        SET FLDS=".01,1"

           SET DHD="[QAC NOPAT HEADER]"

 +10       SET BY="37;S3;C25,'2,1"

 +11       SET FR(1)="@"

           SET TO(1)=""

 +12       IF +$GET(QAC1DIV)

               Begin DoDot:1

 +13               SET QACDVNAM=""

                   DO INST^QACUTL0(QAC1DIV,.QACDVNAM)

 +14               SET (FR(1),TO(1))=QACDVNAM

               End DoDot:1

 +15       SET FR(2)="@"

           SET TO(2)="@"

 +16       SET FR(3)=QAQNBEG

           SET TO(3)=QAQNEND

 +17       DO EN1^DIP

EXIT      ;

 +1        KILL DIC,FLDS,L,BY,FR,TO,DHD,DIP,QACPOP,QACDV,QAC1DIV,QACDVNAM

 +2        KILL QAQNBEG,QAQNEND,QAQPOP

 +3        DO K^QAQDATE

 +4        QUIT