APSPCV.m

APSPCV ; IHS/DSD/ENM - CREATE PRIMARY CARE VISIT FROM OPTION ;  [ 09/03/97   1:30 PM ]

 ;;6.0;IHS PHARMACY MODIFICATIONS;;09/03/97

 ;----------------------------------------------------------

START ;

 S APSPCV("NEW")=0

 D DIC

 D:$D(DA) DIE

END D EOJ

 Q

 ;----------------------------------------------------------

DIC ;

 S DIC("A")="Enter Primary Care Visit Date : "

 S DIC(0)="QEAMLW",DIC="^APSPQA(32.6,"

 D ^DIC K DIC,D0,X,DA

 I Y'=-1 S DA=+Y S:$P(Y,U,3)=1 APSPCV("NEW")="1"

 Q

 ;

DIE ;

 S DIE="^APSPQA(32.6,"

 I APSPCV("NEW") S DR=".02;.03////^S X=DUZ;.04",DIE("NO^")="N"

 I 'APSPCV("NEW") S DR=".01:04"

 I $P(%APSITE,U,15)'="Y" S DR=DR_";1100"

 D ^DIE

 K DIE("NO^")

 Q

 ;

EOJ ;

 K DIE,DA,DIC,APSPCV,DR,DIE("NO^"),X,Y

 Q

APSPCV    ; IHS/DSD/ENM - CREATE PRIMARY CARE VISIT FROM OPTION ;  [ 09/03/97   1:30 PM ]

 +1       ;;6.0;IHS PHARMACY MODIFICATIONS;;09/03/97

 +2       ;----------------------------------------------------------

START     ;

 +1        SET APSPCV("NEW")=0

 +2        DO DIC

 +3        IF $DATA(DA)

               DO DIE

END        DO EOJ

 +1        QUIT 

 +2       ;----------------------------------------------------------

DIC       ;

 +1        SET DIC("A")="Enter Primary Care Visit Date : "

 +2        SET DIC(0)="QEAMLW"

           SET DIC="^APSPQA(32.6,"

 +3        DO ^DIC

           KILL DIC,D0,X,DA

 +4        IF Y'=-1

               SET DA=+Y

               IF $PIECE(Y,U,3)=1

                   SET APSPCV("NEW")="1"

 +5        QUIT 

 +6       ;

DIE       ;

 +1        SET DIE="^APSPQA(32.6,"

 +2        IF APSPCV("NEW")

               SET DR=".02;.03////^S X=DUZ;.04"

               SET DIE("NO^")="N"

 +3        IF 'APSPCV("NEW")

               SET DR=".01:04"

 +4        IF $PIECE(%APSITE,U,15)'="Y"

               SET DR=DR_";1100"

 +5        DO ^DIE

 +6        KILL DIE("NO^")

 +7        QUIT 

 +8       ;

EOJ       ;

 +1        KILL DIE,DA,DIC,APSPCV,DR,DIE("NO^"),X,Y

 +2        QUIT